*----------------------------------------------------------------- * GENERATED APPLICATION: CALLED BATCH *----------------------------------------------------------------- IDENTIFICATION DIVISION. PROGRAM-ID. PGGSS1. AUTHOR. NONE INSTALLATION. NONE DATE WRITTEN. 02.06.2000. DATE COMPILED. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. *----------------------------------------------------------------- * APPLICATION NAME : PGGSS1 * APPLICATION TYPE : CALLEDBATCH * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:33:25 * GENERATION SYSTEM : MVSCICS * GENERATION DATE : 02.06.2000 * GENERATION TIME : 18:18:55 * GENERATION OPTIONS : * ANSISQL(NO) * CICSDBCS(NO) * COMMLVL(4) * CONTABLE(ELACNTUR) * DATA(31) * DEBUGTRACE(NO) * ENDCOMMAREA(NO) * FOLD(NO) * GENRET(NO) * INEDIT(ALL) * INITADDWS(YES) * INITRECD(YES) * LINEINFO(NO) * MATH(COBOL) * NUMOVFL(YES) * PREPFILE(YES) * PRINTDEST(EZEP) * SPZERO(NO) * SYNCDXFR(YES) * SYSCODES(YES) * TARGNLS(ENU) * TRACE() * TRANSID(DBSV,) * TWAOFF(0) * USERID(DGNM) * VALIDMIX(YES) * WORKDB(AUX) * * PROLOGUE: * *----------------------------------------------------------------- INPUT-OUTPUT SECTION. DATA DIVISION. WORKING-STORAGE SECTION. * RTS APPLICATION PROFILE BLOCK 01 EZEAPP-PROFILE SYNCHRONIZED. 05 FILLER PIC X(8) VALUE "ELARHAPP". 05 EZEAPP-APPL-NAME PIC X(8) VALUE "PGGSS1". 05 EZEAPP-PGM-VERSION. 10 EZEAPP-GEN-DATE PIC X(8) VALUE "20000615". 10 EZEAPP-GEN-TIME PIC X(8) VALUE "18190512". 05 EZEAPP-RTS-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-GEN-VERSION PIC X(16) VALUE "040301". 05 EZEAPP-COB-SYS PIC X(8) VALUE "MVSCICS". 05 EZEAPP-CALLER-PROFILE USAGE IS POINTER VALUE NULL. 05 EZEAPP-EZE-WORDS-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-CURS-BLK-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-DLI-SCAN-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-MSP-IDENT-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-SPA-LEN PIC S9(9) COMP VALUE +0. 05 EZEAPP-MAX-MSG-LEN PIC S9(9) COMP VALUE +0. 05 EZEAPP-WSR-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-DB-IO-LEN PIC S9(9) COMP VALUE +65535. 05 EZEAPP-PARM-VAL-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-1ST-MAP-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-PSBNAME PIC X(8) VALUE SPACES. 05 EZEAPP-PCB-CNT PIC S9(4) COMP VALUE +0. 05 EZEAPP-MS-PCB-NO PIC S9(4) COMP VALUE ZERO. 05 EZEAPP-WK-PCB-NO PIC S9(4) COMP VALUE +0. 05 EZEAPP-ERRDEST PIC X(8) VALUE SPACES. 05 EZEAPP-LOG-ID PIC X(1) VALUE LOW-VALUES. 05 EZEAPP-MSP-PROGRAM PIC X(8) VALUE SPACES. 05 EZEAPP-MAP-GROUP PIC X(8) VALUE SPACES. 05 EZEAPP-HELP-MAP-GROUP PIC X(8) VALUE SPACES. 05 EZEAPP-HELP-PF-KEY PIC X(2) VALUE "01". 05 EZEAPP-BYPASS-PF-KEYS. 10 FILLER PIC X(10) VALUE SPACES. 05 FILLER REDEFINES EZEAPP-BYPASS-PF-KEYS. 10 EZEAPP-BYPASS-PF-KEY PIC X(2) OCCURS 5 TIMES. 05 EZEAPP-MSG-FILE-ID PIC X(4) VALUE SPACES. 05 EZEAPP-MS-DB-TYPE PIC X(1) VALUE "5". 05 EZEAPP-WK-DB-TYPE PIC X(1) VALUE "3". 05 EZEAPP-ADF-SPA PIC X(1) VALUE "N". 05 EZEAPP-APPL-TYPE PIC X(1) VALUE "4". 05 EZEAPP-EXECMODE PIC X(1) VALUE "1". 05 EZEAPP-SCAN-IO-PCB PIC X(1) VALUE "N". 05 EZEAPP-PF1-12-IS-PF13-24 PIC X(1) VALUE "Y". 05 EZEAPP-NLS-CODE PIC X(3) VALUE "ENU". 05 EZEAPP-CURRENCY-SYMBOL PIC X(1) VALUE "T". 05 EZEAPP-DECIMAL-SYMBOL PIC X(1) VALUE ",". 05 EZEAPP-NUM-SEP-SYMBOL PIC X(1) VALUE ".". 05 EZEAPP-MATH PIC X(5) VALUE "COBOL". 05 EZEAPP-SYSTEM-RTN-CODES PIC X(1) VALUE "Y". 05 EZEAPP-ENTRY-FUNCTION PIC X(2) VALUE LOW-VALUES. 05 EZEAPP-MS-RTB-ADDRESS USAGE IS POINTER VALUE NULL. 05 EZEAPP-TBK-STACK-SIZE PIC S9(9) COMP VALUE +0. 05 FILLER PIC X(8) VALUE LOW-VALUES. 05 EZEAPP-FAST-PATH-SW PIC X(1) VALUE "N". 05 EZEAPP-RECOVERY-SW PIC X(1) VALUE "N". 05 FILLER PIC X(1) VALUE LOW-VALUES. 05 EZEAPP-EZEDESTP-CHANGED PIC X(1) VALUE "N". 05 EZEAPP-LINK-TYPE PIC X(1) VALUE "4". 05 EZEAPP-PARM-FORM PIC X(1) VALUE "1". 05 EZEAPP-CURS-BLK-CNT PIC S9(4) COMP VALUE +4. 05 EZEAPP-TWA-LENGTH PIC S9(9) COMP VALUE +0. 05 EZEAPP-TWA-ADDRESS USAGE IS POINTER VALUE NULL. 05 EZEAPP-TWA-USER-LENGTH PIC S9(9) COMP VALUE 0. 05 EZEAPP-MAX-SSA-LENGTH PIC S9(9) COMP VALUE +0. 05 EZEAPP-LTB-ARRAY-ADDRESS USAGE IS POINTER VALUE NULL. 05 EZEAPP-ENTRY-COMMAREA-PTR USAGE IS POINTER VALUE NULLS. 05 FILLER PIC X(1) VALUE SPACES. 05 EZEAPP-NEED-ENDB PIC X(1) VALUE "N". 05 EZEAPP-BAD-RESP PIC X(1) VALUE "N". 05 FILLER PIC X(1) VALUE SPACES. 05 EZEAPP-SYNC-XFERS-SW PIC X(1) VALUE "N". 05 EZEAPP-SYNC-DXFRS-SW PIC X(1) VALUE "Y". 05 EZEAPP-STATIC-CALLS PIC X(1) VALUE "N". 05 EZEAPP-INEDIT-UNP-SW PIC X(1) VALUE "N". 05 EZEAPP-MAX-DB-IOAREA PIC S9(9) COMP VALUE +32767. 05 EZEAPP-LAST-MAPBUF-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-FIRST-MAPBUF-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-ROWS-USED-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-MAPG-MOD-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-HELPG-MOD-PTR USAGE IS POINTER VALUE NULL. 05 EZEAPP-CURRENT-RSCT-IDX PIC S9(9) COMP VALUE +0. 05 EZEAPP-CURRENT-HELP-MAP PIC X(8) VALUE SPACES. 05 EZEAPP-EZEDESTP. 10 EZEDESTP PIC X(65) VALUE SPACES. 05 EZEAPP-OPEN-NEW-DESTP PIC X(1) VALUE "N". 05 EZEAPP-EZEDESTP-DIFF PIC X(1) VALUE "N". 05 EZEAPP-USES-SQL PIC X(1) VALUE "Y". 05 EZEAPP-XFER-MAP PIC X(8) VALUE LOW-VALUES. 05 FILLER PIC X(21) VALUE LOW-VALUES. * RTS ERROR HANDLING REQUEST BLOCK COPY ELAEHERR. * RTS SQL ERROR HANDLING REQUEST BLOCK COPY ELA2HERR. 01 EZECICS-TMP-2BYTE-COMP PIC S9(4) COMP VALUE ZERO. * RTS MNEMONICS COPY ELARHMNE. * RTS REQUEST BLOCK COPY ELARHRRB. * DISPLAY SERVICES REQUEST BLOCK COPY ELARHFMR. * EZE SPECIAL FUNCTION WORDS 01 EZEWORDS. 05 EZEEZE-ID PIC X(8) VALUE "ELARHEZE". 05 EZEWORDS-LL PIC S9(9) COMP VALUE +334. 05 EZEWORDS-I. 10 EZEAID PIC X(2) VALUE SPACES. 88 EZEAID-ENTER VALUE " ". 88 EZEAID-CLEAR VALUE "CL". 88 EZEAID-PAKEY VALUE "P1" "P2" "P3". 88 EZEAID-PA1 VALUE "P1". 88 EZEAID-PA2 VALUE "P2". 88 EZEAID-PA3 VALUE "P3". 10 EZEAID-BYPASS-SW PIC X(1) VALUE SPACES. 88 EZEAID-BYPASS VALUE "Y". 88 EZEAID-NO-BYPASS VALUE "N". 10 EZEAID-HELP-SW PIC X(1) VALUE SPACES. 88 EZEAID-HELP VALUE "Y". 88 EZEAID-NO-HELP VALUE "N". 10 EZEAPP PIC X(8) VALUE SPACES. 10 EZECNVCM PIC 9(1) VALUE 0. 88 EZECNVCM-NOCOMMIT VALUE 0. 88 EZECNVCM-COMMIT VALUE 1. 10 EZEDLTRM REDEFINES EZECNVCM PIC 9(1). 10 FILLER PIC X(5) VALUE LOW-VALUES. 10 EZELOC PIC X(8) VALUE SPACES. 10 EZEDLCER PIC X(2) VALUE "00". 10 EZEDLCON PIC X(2) VALUE "00". 10 FILLER PIC 9(7) VALUE ZEROES. 10 EZEFEC PIC 9(1) VALUE ZEROES. 88 EZEFEC-TERMINATE VALUE 0. 88 EZEFEC-CONTINUE VALUE 1. 10 EZEDLERR PIC 9(1) VALUE ZEROES. 88 EZEDLERR-TERMINATE VALUE 0. 88 EZEDLERR-CONTINUE VALUE 1. 10 EZESQISL PIC 9(1) VALUE ZEROES. 10 EZEMNO PIC S9(4) COMP VALUE ZEROES. 88 EZEMNO-ERROR VALUES 1 THRU 9998 -9999 THRU -1. 88 EZEMNO-NO-ERROR VALUE 0. 88 EZEMNO-RE-CONVERSE VALUE 9999. 10 EZEMNO-MSG-FILE-SW PIC X(1) VALUE "N". 88 EZEMNO-APP-MSG-FILE VALUE "Y". 88 EZEMNO-SYS-MSG-FILE VALUE "N". 10 EZEMSG PIC X(78). 88 EZEMSG-SPACES VALUE SPACES. 10 EZEOVER PIC 9(1) VALUE ZEROES. 88 EZEOVER-DEFAULT VALUE 0. 88 EZEOVER-TERMINATE VALUE 1. 88 EZEOVER-CONTINUE VALUE 2. 10 EZEOVERS PIC 9(1) VALUE ZEROES. 10 EZERCODE PIC S9(9) COMP VALUE ZEROES. 10 EZERT2 PIC X(2) VALUE SPACES. 10 EZERT8. 15 EZERT8FS. 20 EZERT8FH PIC 9(1). 20 EZERT8FL PIC 9(1). 15 EZERT8VS. 20 EZERT8VR PIC 9(2). 20 EZERT8VF PIC 9(1). 20 EZERT8VB PIC 9(3). 10 EZERT8-CICS REDEFINES EZERT8. 15 EZERT8-RESP PIC 9(4). 15 EZERT8-RESP2 PIC 9(4). 10 EZESEGM PIC 9(1) VALUE 0. 88 EZESEGM-NONSEGMENT VALUE 0. 88 EZESEGM-SEGMENTED VALUE 1. 88 EZESEGM-DEFINED VALUE 0. 10 EZECONVT PIC X(8) VALUE SPACES. 10 EZETST PIC S9(4) COMP VALUE ZEROES. 10 EZETST2 PIC S9(4) COMP VALUE ZEROES. 10 EZESQLCA. 15 EZESQNAM PIC X(8) VALUE SPACES. 15 EZESQABC PIC S9(9) COMP VALUE ZEROES. 15 EZESQCOD PIC S9(9) COMP VALUE ZEROES. 15 EZESQRRL PIC S9(4) COMP VALUE ZEROES. 15 EZESQRRM. 20 EZESQRET PIC X OCCURS 70 TIMES INDEXED BY EZESQSUB. 15 EZESQRRP. 20 EZESQRPP PIC X(3) VALUE SPACES. 20 EZESQRVM PIC X(5) VALUE SPACES. 15 EZESQRD1 PIC S9(9) COMP VALUE ZEROES. 15 EZESQRD2 PIC S9(9) COMP VALUE ZEROES. 15 EZESQRD3 PIC S9(9) COMP VALUE ZEROES. 15 EZESQRD4 PIC S9(9) COMP VALUE ZEROES. 15 EZESQRD5 PIC S9(9) COMP VALUE ZEROES. 15 EZESQRD6 PIC S9(9) COMP VALUE ZEROES. 15 FILLER PIC X(1) VALUE SPACES. 15 EZESQWN1 PIC X(1) VALUE SPACES. 15 FILLER PIC X(4) VALUE SPACES. 15 EZESQWN6 PIC X(1) VALUE SPACES. 15 FILLER PIC X(9) VALUE SPACES. 10 EZEDL-PCB-INFO. 15 EZEDLDBD PIC X(8) VALUE SPACES. 15 EZEDLLEV PIC 9(2) VALUE ZEROES. 15 EZEDLSTC PIC X(2) VALUE SPACES. 15 EZEDLPRO PIC X(4) VALUE SPACES. 15 FILLER PIC X(4) VALUE SPACES. 15 EZEDLSEG PIC X(8) VALUE SPACES. 15 EZEDLKYL PIC S9(4) COMP VALUE 1. 15 EZEDLSSG PIC S9(4) COMP VALUE ZEROES. 05 EZEMNO-LOOKED-UP-SW PIC X(1) VALUE "N". 88 EZEMNO-LOOKED-UP VALUE "Y". 88 EZEMNO-NOT-LOOKED-UP VALUE "N". 05 EZESYS PIC X(8) VALUE "MVSCICS". 88 EZESYS-IMSVS VALUE "IMSVS". 88 EZESYS-IMSBMP VALUE "IMSBMP". 88 EZESYS-MVSBATCH VALUE "MVSBATCH". 88 EZESYS-MVSCICS VALUE "MVSCICS". 88 EZESYS-OS2CICS VALUE "OS2CICS". 88 EZESYS-TSO VALUE "TSO". 88 EZESYS-VSECICS VALUE "VSECICS". 88 EZESYS-VSEBATCH VALUE "VSEBATCH". 88 EZESYS-OS400 VALUE "OS400". 88 EZESYS-OS2GUI VALUE "OS2GUI". 88 EZESYS-OS2 VALUE "OS2". 88 EZESYS-AIX VALUE "AIX". 88 EZESYS-WINGUI VALUE "WINGUI". 88 EZESYS-AIXCICS VALUE "AIXCICS". 88 EZESYS-VMCMS VALUE "VMCMS". 88 EZESYS-VMBATCH VALUE "VMBATCH". 88 EZESYS-HP VALUE "HP". 88 EZESYS-ITF VALUE "ITF". 88 EZESYS-NTCICS VALUE "NTCICS". 88 EZESYS-WINNT VALUE "WINNT". 05 FILLER PIC X(2) VALUE LOW-VALUES. 05 EZEDLKEY. 10 EZEDLKYC PIC X(1). * FIXED WORK FIELDS COPY ELARHWRK. 01 EZECTL-CALL-FIELDS. 05 EZECTL-RETURN-CODE PIC S9(4) COMP. 05 EZECTL-INDEX PIC S9(4) COMP. 05 EZECTL-HOLD-EZEDLPSB PIC X(8). 05 EZECTL-HOLD-CTL-MODE PIC X(1). 05 EZECTL-HOLD-CTL-REQUEST PIC X(1). 01 EZECTL-CONTROL-FIELDS. 05 EZECTL-IN-EZETERMINATE-FLAG PIC X(1) VALUE "N". 88 EZECTL-IN-EZETERMINATE VALUE "Y". 88 EZECTL-NOT-IN-EZETERMINATE VALUE "N". 01 EZECTL-FUNCTION-RETURN-CODE. 05 EZECTL-FUNCTION-RC-BIN-2 PIC S9(4) COMP. 05 EZECTL-FUNCTION-RC-BIN-4 PIC S9(9) COMP. 05 EZECTL-FUNCTION-RC-NUM-8 PIC 9(8). *----------------------------------------------------------------- * EXTERNAL PARAMETER CONTROL BLOCK *----------------------------------------------------------------- 01 EZEPARM-VALIDATION. 05 EZEPARM-ID PIC X(8) VALUE "ELARHPRM". 05 EZEPARM-COUNT PIC S9(4) COMP VALUE +6. 05 EZEPARM-TYPES. 10 FILLER PIC X(1) VALUE "4". 10 FILLER PIC X(1) VALUE "4". 10 FILLER PIC X(1) VALUE "4". 10 FILLER PIC X(1) VALUE "4". 10 FILLER PIC X(1) VALUE "4". 10 FILLER PIC X(1) VALUE "4". *----------------------------------------------------------------- * WORKING STORAGE RECORD VDBCOMMON *----------------------------------------------------------------- 01 EZEWS-VDBCOMMON-GP. 02 EZEWS-ID PIC X(8) VALUE "ELAASGWS". 02 EZEWS-VDBCOMMON-LL PIC S9(8) COMP VALUE +158. 02 FILLER PIC X(2) VALUE SPACES. 02 FILLER PIC X(18) VALUE "VDBCOMMON". *----------------------------------------------------------------- * RECORD NAME : VDBCOMMON * FILE ORGANIZATION : WORKSTOR * MODIFICATION DATE : 01.06.2000 * MODIFICATION TIME : 10:48:58 * RECORD PROLOGUE : * ************************************************************ * * Record : VDBCOMMON * * * * Function : Database information and control record * * to be used in the application itself * * ************************************************************ *----------------------------------------------------------------- 02 VDBCOMMON. * General Purpose Index 05 UINDEX1 PIC S9(4) VALUE ZERO USAGE COMP. * General Purpose Index 05 UINDEX2 PIC S9(4) VALUE ZERO USAGE COMP. * General Purpose Index 05 UINDEX3 PIC S9(4) VALUE ZERO USAGE COMP. * Genral Purpose Index 05 UINDEX4 PIC S9(4) VALUE ZERO USAGE COMP. * General Purpose Index 05 UINDEX5 PIC S9(4) VALUE ZERO USAGE COMP. * Last Update Date Timestamp 05 ULAST-UPDATE-TS PIC X(26) VALUE SPACES USAGE DISPLAY. * Application Name 05 UAPPLNAM PIC X(7) VALUE SPACES USAGE DISPLAY. 05 EZE-REDEF-1 REDEFINES UAPPLNAM. * Application Prefix 06 UAPPLPFX PIC X(3) USAGE DISPLAY. 06 EZE-REDEF-2 REDEFINES UAPPLPFX. * Project/System ID - 1st Char 07 USYSID1 PIC X(1) USAGE DISPLAY. * Application ID 07 UAPPLID PIC X(2) USAGE DISPLAY. * Application Suffix 06 UAPPLSFX PIC X(4) USAGE DISPLAY. * Process Name 05 UPROCNAM PIC X(30) VALUE SPACES USAGE DISPLAY. * Table Name 05 UTABLNAM PIC X(30) VALUE SPACES USAGE DISPLAY. * SQL Row Record Name 05 USQLREC PIC X(18) VALUE SPACES USAGE DISPLAY. * NRF Flag 05 UNRF PIC X(1) VALUE SPACES USAGE DISPLAY. * Duplicate Key Flag 05 UDUP PIC X(1) VALUE SPACES USAGE DISPLAY. * SQL Number Item 05 USQLNUM PIC S9(3) VALUE ZERO USAGE DISPLAY. * SQL Code (CHA) 05 UEZESQCD PIC X(4) VALUE SPACES USAGE DISPLAY. 05 EZE-REDEF-3 REDEFINES UEZESQCD. * Number Sign 06 USIGN PIC X(1) USAGE DISPLAY. * SQL Code Insert 06 USQLCHA PIC X(3) USAGE DISPLAY. 02 FILLER PIC X(4) VALUE "*END". EXEC SQL INCLUDE SQLCA END-EXEC. * SQL ITEM REQUEST BLOCK COPY ELASHSQI. *----------------------------------------------------------------- * RECORD NAME = BIRIMM * TABLE NAME = BORDRO.BIRIM * SQL ROW ITEM SQL COLUMN * BIRIM_KOD BIRIM_KOD * BIRIM_AD BIRIM_AD *----------------------------------------------------------------- 01 EZESTA-BIRIMM-GP. 02 EZESTA-ID PIC X(8) VALUE "ELAASGSR". 02 EZESTA-BIRIMM-LL PIC S9(8) COMP VALUE +64. 02 EZESTA-BIRIMM-RC PIC S9(2) VALUE 00. 88 EZESTA-BIRIMM-OK VALUE 00. 88 EZESTA-BIRIMM-ERR VALUES ARE -99 THRU -01 01 THRU 99. 88 EZESTA-BIRIMM-SFT VALUES ARE 01 THRU 99. 88 EZESTA-BIRIMM-DED VALUE -01. 88 EZESTA-BIRIMM-DUP VALUE -05. 88 EZESTA-BIRIMM-EOF VALUE 03 07. 88 EZESTA-BIRIMM-NRF VALUE 04 07. 88 EZESTA-BIRIMM-UNQ VALUE -05. 88 EZESTA-BIRIMM-HRD VALUES ARE -99 THRU -01. 88 EZESTA-BIRIMM-FUL VALUE -06. 88 EZESTA-BIRIMM-FNA VALUE -07. 88 EZESTA-BIRIMM-FMT VALUE -08. 88 EZESTA-BIRIMM-FNF VALUE -09. 88 EZESTA-BIRIMM-LOK VALUE -10. 02 FILLER PIC X(18) VALUE "BIRIMM". *----------------------------------------------------------------- * RECORD NAME : BIRIMM * FILE ORGANIZATION : SQLROW * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:28:55 * RECORD PROLOGUE : * *----------------------------------------------------------------- 02 BIRIMM. 10 FILLER PIC X(4). * BIRIM_KOD WAS RENAMED TO EZEI-1 10 EZEI-1 PIC X(3) USAGE DISPLAY. 10 FILLER PIC X(4). * BIRIM_AD WAS RENAMED TO EZEI-2 10 EZEI-2 PIC X(25) USAGE DISPLAY. 02 EZESQL-BIRIMM-H REDEFINES BIRIMM. 10 FILLER PIC X(4). 10 EZEI-1 PIC X(3) USAGE DISPLAY. 10 FILLER PIC X(4). 10 EZEI-2 PIC X(25) USAGE DISPLAY. 02 EZESQL-BIRIMM-I REDEFINES BIRIMM. 10 EZEI-1 PIC S9(4) COMP. 10 FILLER PIC X(5). 10 EZEI-2 PIC S9(4) COMP. 10 FILLER PIC X(27). 02 FILLER PIC X(4) VALUE "*END". *----------------------------------------------------------------- * RECORD NAME = GOREVM * TABLE NAME = BORDRO.GOREV * SQL ROW ITEM SQL COLUMN * GOREV_KOD GOREV_KOD * GOREV_AD GOREV_AD *----------------------------------------------------------------- 01 EZESTA-GOREVM-GP. 02 EZESTA-ID PIC X(8) VALUE "ELAASGSR". 02 EZESTA-GOREVM-LL PIC S9(8) COMP VALUE +60. 02 EZESTA-GOREVM-RC PIC S9(2) VALUE 00. 88 EZESTA-GOREVM-OK VALUE 00. 88 EZESTA-GOREVM-ERR VALUES ARE -99 THRU -01 01 THRU 99. 88 EZESTA-GOREVM-SFT VALUES ARE 01 THRU 99. 88 EZESTA-GOREVM-DED VALUE -01. 88 EZESTA-GOREVM-DUP VALUE -05. 88 EZESTA-GOREVM-EOF VALUE 03 07. 88 EZESTA-GOREVM-NRF VALUE 04 07. 88 EZESTA-GOREVM-UNQ VALUE -05. 88 EZESTA-GOREVM-HRD VALUES ARE -99 THRU -01. 88 EZESTA-GOREVM-FUL VALUE -06. 88 EZESTA-GOREVM-FNA VALUE -07. 88 EZESTA-GOREVM-FMT VALUE -08. 88 EZESTA-GOREVM-FNF VALUE -09. 88 EZESTA-GOREVM-LOK VALUE -10. 02 FILLER PIC X(18) VALUE "GOREVM". *----------------------------------------------------------------- * RECORD NAME : GOREVM * FILE ORGANIZATION : SQLROW * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:28:09 * RECORD PROLOGUE : * *----------------------------------------------------------------- 02 GOREVM. 10 FILLER PIC X(4). * GOREV_KOD WAS RENAMED TO EZEI-5 10 EZEI-5 PIC X(4) USAGE DISPLAY. 10 FILLER PIC X(4). * GOREV_AD WAS RENAMED TO EZEI-6 10 EZEI-6 PIC X(20) USAGE DISPLAY. 02 EZESQL-GOREVM-H REDEFINES GOREVM. 10 FILLER PIC X(4). 10 EZEI-5 PIC X(4) USAGE DISPLAY. 10 FILLER PIC X(4). 10 EZEI-6 PIC X(20) USAGE DISPLAY. 02 EZESQL-GOREVM-I REDEFINES GOREVM. 10 EZEI-5 PIC S9(4) COMP. 10 FILLER PIC X(6). 10 EZEI-6 PIC S9(4) COMP. 10 FILLER PIC X(22). 02 FILLER PIC X(4) VALUE "*END". *----------------------------------------------------------------- * RECORD NAME = PERSONEL * TABLE NAME = BORDRO.PERSONEL * SQL ROW ITEM SQL COLUMN * SICIL SICIL * AD_SOYAD AD_SOYAD * CINSIYET CINSIYET * OGRENIM OGRENIM * SUBE_KOD SUBE_KOD * BIRIM_KOD BIRIM_KOD * GOREV_KOD GOREV_KOD *----------------------------------------------------------------- 01 EZESTA-PERSONEL-GP. 02 EZESTA-ID PIC X(8) VALUE "ELAASGSR". 02 EZESTA-PERSONEL-LL PIC S9(8) COMP VALUE +112. 02 EZESTA-PERSONEL-RC PIC S9(2) VALUE 00. 88 EZESTA-PERSONEL-OK VALUE 00. 88 EZESTA-PERSONEL-ERR VALUES ARE -99 THRU -01 01 THRU 99. 88 EZESTA-PERSONEL-SFT VALUES ARE 01 THRU 99. 88 EZESTA-PERSONEL-DED VALUE -01. 88 EZESTA-PERSONEL-DUP VALUE -05. 88 EZESTA-PERSONEL-EOF VALUE 03 07. 88 EZESTA-PERSONEL-NRF VALUE 04 07. 88 EZESTA-PERSONEL-UNQ VALUE -05. 88 EZESTA-PERSONEL-HRD VALUES ARE -99 THRU -01. 88 EZESTA-PERSONEL-FUL VALUE -06. 88 EZESTA-PERSONEL-FNA VALUE -07. 88 EZESTA-PERSONEL-FMT VALUE -08. 88 EZESTA-PERSONEL-FNF VALUE -09. 88 EZESTA-PERSONEL-LOK VALUE -10. 02 FILLER PIC X(18) VALUE "PERSONEL". *----------------------------------------------------------------- * RECORD NAME : PERSONEL * FILE ORGANIZATION : SQLROW * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 14:44:54 * RECORD PROLOGUE : * *----------------------------------------------------------------- 02 PERSONEL. 10 FILLER PIC X(4). 10 SICIL PIC X(5) USAGE DISPLAY. 10 FILLER PIC X(4). * AD_SOYAD WAS RENAMED TO EZEI-10 10 EZEI-10 PIC X(35) USAGE DISPLAY. 10 FILLER PIC X(4). 10 CINSIYET PIC X(1) USAGE DISPLAY. 10 FILLER PIC X(4). 10 OGRENIM PIC X(4) USAGE DISPLAY. 10 FILLER PIC X(4). * SUBE_KOD WAS RENAMED TO EZEI-11 10 EZEI-11 PIC X(4) USAGE DISPLAY. 10 FILLER PIC X(4). * BIRIM_KOD WAS RENAMED TO EZEI-12 10 EZEI-12 PIC X(3) USAGE DISPLAY. 10 FILLER PIC X(4). * GOREV_KOD WAS RENAMED TO EZEI-13 10 EZEI-13 PIC X(4) USAGE DISPLAY. 02 EZESQL-PERSONEL-H REDEFINES PERSONEL. 10 FILLER PIC X(4). 10 SICIL PIC X(5) USAGE DISPLAY. 10 FILLER PIC X(4). 10 EZEI-10 PIC X(35) USAGE DISPLAY. 10 FILLER PIC X(4). 10 CINSIYET PIC X(1) USAGE DISPLAY. 10 FILLER PIC X(4). 10 OGRENIM PIC X(4) USAGE DISPLAY. 10 FILLER PIC X(4). 10 EZEI-11 PIC X(4) USAGE DISPLAY. 10 FILLER PIC X(4). 10 EZEI-12 PIC X(3) USAGE DISPLAY. 10 FILLER PIC X(4). 10 EZEI-13 PIC X(4) USAGE DISPLAY. 02 EZESQL-PERSONEL-I REDEFINES PERSONEL. 10 SICIL PIC S9(4) COMP. 10 FILLER PIC X(7). 10 EZEI-10 PIC S9(4) COMP. 10 FILLER PIC X(37). 10 CINSIYET PIC S9(4) COMP. 10 FILLER PIC X(3). 10 OGRENIM PIC S9(4) COMP. 10 FILLER PIC X(6). 10 EZEI-11 PIC S9(4) COMP. 10 FILLER PIC X(6). 10 EZEI-12 PIC S9(4) COMP. 10 FILLER PIC X(5). 10 EZEI-13 PIC S9(4) COMP. 10 FILLER PIC X(6). 02 FILLER PIC X(4) VALUE "*END". *----------------------------------------------------------------- * RECORD NAME = SUBEM * TABLE NAME = BORDRO.SUBE * SQL ROW ITEM SQL COLUMN * SUBE_KOD SUBE_KOD * SUBE_AD SUBE_AD *----------------------------------------------------------------- 01 EZESTA-SUBEM-GP. 02 EZESTA-ID PIC X(8) VALUE "ELAASGSR". 02 EZESTA-SUBEM-LL PIC S9(8) COMP VALUE +65. 02 EZESTA-SUBEM-RC PIC S9(2) VALUE 00. 88 EZESTA-SUBEM-OK VALUE 00. 88 EZESTA-SUBEM-ERR VALUES ARE -99 THRU -01 01 THRU 99. 88 EZESTA-SUBEM-SFT VALUES ARE 01 THRU 99. 88 EZESTA-SUBEM-DED VALUE -01. 88 EZESTA-SUBEM-DUP VALUE -05. 88 EZESTA-SUBEM-EOF VALUE 03 07. 88 EZESTA-SUBEM-NRF VALUE 04 07. 88 EZESTA-SUBEM-UNQ VALUE -05. 88 EZESTA-SUBEM-HRD VALUES ARE -99 THRU -01. 88 EZESTA-SUBEM-FUL VALUE -06. 88 EZESTA-SUBEM-FNA VALUE -07. 88 EZESTA-SUBEM-FMT VALUE -08. 88 EZESTA-SUBEM-FNF VALUE -09. 88 EZESTA-SUBEM-LOK VALUE -10. 02 FILLER PIC X(18) VALUE "SUBEM". *----------------------------------------------------------------- * RECORD NAME : SUBEM * FILE ORGANIZATION : SQLROW * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 14:45:09 * RECORD PROLOGUE : * *----------------------------------------------------------------- 02 SUBEM. 10 FILLER PIC X(4). * SUBE_KOD WAS RENAMED TO SUBE-KOD 10 SUBE-KOD PIC X(4) USAGE DISPLAY. 10 FILLER PIC X(4). * SUBE_AD WAS RENAMED TO SUBE-AD 10 SUBE-AD PIC X(25) USAGE DISPLAY. 02 EZESQL-SUBEM-H REDEFINES SUBEM. 10 FILLER PIC X(4). 10 SUBE-KOD PIC X(4) USAGE DISPLAY. 10 FILLER PIC X(4). 10 SUBE-AD PIC X(25) USAGE DISPLAY. 02 EZESQL-SUBEM-I REDEFINES SUBEM. 10 SUBE-KOD PIC S9(4) COMP. 10 FILLER PIC X(6). 10 SUBE-AD PIC S9(4) COMP. 10 FILLER PIC X(27). 02 FILLER PIC X(4) VALUE "*END". LINKAGE SECTION. 01 DFHCOMMAREA. 05 EZECOMMAREA PIC X(32763). 05 EZECOMMAREA-MAPPED REDEFINES EZECOMMAREA. 10 EZECOMMAREA-SSM-STATUS PIC X. 10 EZECOMMAREA-MAP-NAME PIC X(8). 10 EZECOMMAREA-RESERVED-0 PIC X. 10 EZECOMMAREA-USER-AREA PIC X(32753). 05 EZECOMMAREA-POINTERS REDEFINES EZECOMMAREA. 10 EZECOMMAREA-PTR USAGE IS POINTER OCCURS 8190 TIMES. 10 EZECOMMAREA-PTR-RSVD PIC X(3). * RTS CONTROL BLOCK COPY ELARHRTS REPLACING ==SYNCHRONIZED EXTERNAL== BY ==SYNCHRONIZED==. * RTS NLS-DEPENDENT INSTALLATION OPTIONS CONTROL BLOCK COPY ELARHIOE. * RTS NLS-INDEPENDENT INSTALLATION OPTIONS CONTROL BLOCK COPY ELARHIOP. * RESOURCE CONTROL BLOCK COPY ELARHRSC. * STATIC CONTROL BLOCK COPY ELARHSCB. *----------------------------------------------------------------- * RECORD NAME : WPERSONEL * FILE ORGANIZATION : WORKSTOR * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 11:37:50 * RECORD PROLOGUE : * *----------------------------------------------------------------- 01 EZERCD-WPERSONEL-GP. 02 WPERSONEL. 05 SICIL PIC X(5) USAGE DISPLAY. * AD_SOYAD WAS RENAMED TO AD-SOYAD 05 AD-SOYAD PIC X(35) USAGE DISPLAY. 05 CINSIYET PIC X(1) USAGE DISPLAY. 05 OGRENIM PIC X(4) USAGE DISPLAY. * SUBE_KOD WAS RENAMED TO EZEI-7 05 EZEI-7 PIC X(4) USAGE DISPLAY. * BIRIM_KOD WAS RENAMED TO EZEI-8 05 EZEI-8 PIC X(3) USAGE DISPLAY. * GOREV_KOD WAS RENAMED TO EZEI-9 05 EZEI-9 PIC X(4) USAGE DISPLAY. *----------------------------------------------------------------- * RECORD NAME : WSUBE * FILE ORGANIZATION : WORKSTOR * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:18:00 * RECORD PROLOGUE : * *----------------------------------------------------------------- 01 EZERCD-WSUBE-GP. 02 WSUBE. * SUBE_KOD WAS RENAMED TO EZEI-3 05 EZEI-3 PIC X(4) USAGE DISPLAY. * SUBE_AD WAS RENAMED TO EZEI-4 05 EZEI-4 PIC X(25) USAGE DISPLAY. *----------------------------------------------------------------- * RECORD NAME : WBIRIM * FILE ORGANIZATION : WORKSTOR * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:17:40 * RECORD PROLOGUE : * *----------------------------------------------------------------- 01 EZERCD-WBIRIM-GP. 02 WBIRIM. * BIRIM_KOD WAS RENAMED TO BIRIM-KOD 05 BIRIM-KOD PIC X(3) USAGE DISPLAY. * BIRIM_AD WAS RENAMED TO BIRIM-AD 05 BIRIM-AD PIC X(25) USAGE DISPLAY. *----------------------------------------------------------------- * RECORD NAME : WGOREV * FILE ORGANIZATION : WORKSTOR * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:18:21 * RECORD PROLOGUE : * *----------------------------------------------------------------- 01 EZERCD-WGOREV-GP. 02 WGOREV. * GOREV_KOD WAS RENAMED TO GOREV-KOD 05 GOREV-KOD PIC X(4) USAGE DISPLAY. * GOREV_AD WAS RENAMED TO GOREV-AD 05 GOREV-AD PIC X(20) USAGE DISPLAY. *----------------------------------------------------------------- * RECORD NAME : VDBCONTROL * FILE ORGANIZATION : WORKSTOR * MODIFICATION DATE : 01.06.2000 * MODIFICATION TIME : 10:49:21 * RECORD PROLOGUE : * ************************************************************ * * Record : VDBCONTROL * * * * Function : Database and control information to pass * * between umbrella and atomic server * * applications. * * ************************************************************ *----------------------------------------------------------------- 01 EZERCD-VDBCONTROL-GP. 02 VDBCONTROL. * Database Control Record Item 05 UDBCONTROL PIC X(74) USAGE DISPLAY. 05 EZE-REDEF-4 REDEFINES UDBCONTROL. * Return Code (CHA) 06 URCCHAR PIC X(3) USAGE DISPLAY. 06 EZE-REDEF-5 REDEFINES URCCHAR. * Return Code 07 URC PIC S9(3) USAGE DISPLAY. * Rollback Required Flag 06 UROLLBACK PIC X(1) USAGE DISPLAY. * Error Message Inserts from SQL 06 UEZESQRRM PIC X(70) USAGE DISPLAY. * Database Local Area 05 UDBLOCAL PIC X(11) USAGE DISPLAY. 05 EZE-REDEF-6 REDEFINES UDBLOCAL. * SQL Access Type 06 UACCTYP PIC X(1) USAGE DISPLAY. * Access Type Save 06 UACCSAV PIC X(1) USAGE DISPLAY. * Rows Read Counter 06 UROWR PIC S9(9) USAGE COMP. * Rows Written Counter 06 UROWW PIC S9(9) USAGE COMP. * Req. I/O (ISUD) or List (LFB) 06 UIOTYPE PIC X(1) USAGE DISPLAY. * NRF Flag 05 UNRF PIC X(1) USAGE DISPLAY. * HIGH-VALUE WAS RENAMED TO EZEI-HIGH-VALUE 05 EZEI-HIGH-VALUE PIC X(1) USAGE DISPLAY. 05 EZE-REDEF-7 REDEFINES EZEI-HIGH-VALUE. 06 HIGH-VALUE-HEX PIC X(1) USAGE DISPLAY. * LOW-VALUE WAS RENAMED TO EZEI-LOW-VALUE 05 EZEI-LOW-VALUE PIC X(1) USAGE DISPLAY. 05 EZE-REDEF-8 REDEFINES EZEI-LOW-VALUE. 06 LOW-VALUE-HEX PIC X(1) USAGE DISPLAY. * HIGH-VALUES WAS RENAMED TO EZEI-HIGH-VALUES 05 EZEI-HIGH-VALUES PIC X(100) USAGE DISPLAY. 05 EZE-REDEF-9 REDEFINES EZEI-HIGH-VALUES. 06 HIGH-VALUES-CHAR PIC X(1) OCCURS 100 INDEXED BY EZEIDX1 USAGE DISPLAY. * LOW-VALUES WAS RENAMED TO EZEI-LOW-VALUES 05 EZEI-LOW-VALUES PIC X(100) USAGE DISPLAY. 05 EZE-REDEF-10 REDEFINES EZEI-LOW-VALUES. 06 LOW-VALUES-CHAR PIC X(1) OCCURS 100 INDEXED BY EZEIDX2 USAGE DISPLAY. *----------------------------------------------------------------- * RECORD NAME : VMESSAGE * FILE ORGANIZATION : WORKSTOR * MODIFICATION DATE : 01.06.2000 * MODIFICATION TIME : 10:49:43 * RECORD PROLOGUE : * ************************************************************ * * Record : VMESSAGE * * * * Function : Message record. * * * ************************************************************ *----------------------------------------------------------------- 01 EZERCD-VMESSAGE-GP. 02 VMESSAGE. 05 UMSGCONTROL PIC X(224) USAGE DISPLAY. 05 EZE-REDEF-11 REDEFINES UMSGCONTROL. * Message Code 06 UMSGCODE PIC X(8) USAGE DISPLAY. * Message Insert 06 UMSGINS PIC X(30) OCCURS 3 INDEXED BY EZEIDX3 USAGE DISPLAY. * Message Text 06 UMESSAGE PIC X(125) USAGE DISPLAY. * Message Type 06 UMSGTYPE PIC X(1) USAGE DISPLAY. EXEC SQL DECLARE EZE001001PGGSS1 CURSOR FOR SELECT BIRIM_AD FROM BORDRO.BIRIM T1 WHERE BIRIM_KOD = :EZESQL-BIRIMM-H.EZEI-1:EZESQL-BIRIMM-I.EZEI-1 END-EXEC. EXEC SQL DECLARE EZE002001PGGSS1 CURSOR FOR SELECT GOREV_AD FROM BORDRO.GOREV T1 WHERE GOREV_KOD = :EZESQL-GOREVM-H.EZEI-5:EZESQL-GOREVM-I.EZEI-5 END-EXEC. EXEC SQL DECLARE EZE003001PGGSS1 CURSOR FOR SELECT AD_SOYAD , CINSIYET , OGRENIM , SUBE_KOD , BIRIM_KOD , GOREV_KOD FROM BORDRO.PERSONEL T1 WHERE SICIL = :EZESQL-PERSONEL-H.SICIL:EZESQL-PERSONEL-I.SICIL END-EXEC. EXEC SQL DECLARE EZE004001PGGSS1 CURSOR FOR SELECT SUBE_AD FROM BORDRO.SUBE T1 WHERE SUBE_KOD = :EZESQL-SUBEM-H.SUBE-KOD:EZESQL-SUBEM-I.SUBE-KOD END-EXEC. *----------------------------------------------------------------- * SQL CURSOR CONTROL BLOCKS *----------------------------------------------------------------- 01 EZECRS-CURSOR-BLOCKS. 02 EZECRS-ID PIC X(8). 02 EZECRS-CNT PIC S9(4) COMP. *----------------------------------------------------------------- * CURSOR CONTROL BLOCK FOR SQL ROW BIRIMM *----------------------------------------------------------------- 02 EZECRS-BIRIMM-CB. 05 EZECRS-BIRIMM-TYP PIC X(4). 88 EZECRS-BIRIMM-SETI VALUE "SETI". 88 EZECRS-BIRIMM-SETU VALUE "SETU". 88 EZECRS-BIRIMM-SIWH VALUE "SIWH". 88 EZECRS-BIRIMM-SUWH VALUE "SUWH". 88 EZECRS-BIRIMM-UPDT VALUE "UPDT". 88 EZECRS-BIRIMM-INQU VALUE "INQU". 05 EZECRS-BIRIMM-ID PIC S9(4) COMP. 88 EZECRS-BIRIMM-CLOS VALUE 0. *----------------------------------------------------------------- * CURSOR CONTROL BLOCK FOR SQL ROW GOREVM *----------------------------------------------------------------- 02 EZECRS-GOREVM-CB. 05 EZECRS-GOREVM-TYP PIC X(4). 88 EZECRS-GOREVM-SETI VALUE "SETI". 88 EZECRS-GOREVM-SETU VALUE "SETU". 88 EZECRS-GOREVM-SIWH VALUE "SIWH". 88 EZECRS-GOREVM-SUWH VALUE "SUWH". 88 EZECRS-GOREVM-UPDT VALUE "UPDT". 88 EZECRS-GOREVM-INQU VALUE "INQU". 05 EZECRS-GOREVM-ID PIC S9(4) COMP. 88 EZECRS-GOREVM-CLOS VALUE 0. *----------------------------------------------------------------- * CURSOR CONTROL BLOCK FOR SQL ROW PERSONEL *----------------------------------------------------------------- 02 EZECRS-PERSONEL-CB. 05 EZECRS-PERSONEL-TYP PIC X(4). 88 EZECRS-PERSONEL-SETI VALUE "SETI". 88 EZECRS-PERSONEL-SETU VALUE "SETU". 88 EZECRS-PERSONEL-SIWH VALUE "SIWH". 88 EZECRS-PERSONEL-SUWH VALUE "SUWH". 88 EZECRS-PERSONEL-UPDT VALUE "UPDT". 88 EZECRS-PERSONEL-INQU VALUE "INQU". 05 EZECRS-PERSONEL-ID PIC S9(4) COMP. 88 EZECRS-PERSONEL-CLOS VALUE 0. *----------------------------------------------------------------- * CURSOR CONTROL BLOCK FOR SQL ROW SUBEM *----------------------------------------------------------------- 02 EZECRS-SUBEM-CB. 05 EZECRS-SUBEM-TYP PIC X(4). 88 EZECRS-SUBEM-SETI VALUE "SETI". 88 EZECRS-SUBEM-SETU VALUE "SETU". 88 EZECRS-SUBEM-SIWH VALUE "SIWH". 88 EZECRS-SUBEM-SUWH VALUE "SUWH". 88 EZECRS-SUBEM-UPDT VALUE "UPDT". 88 EZECRS-SUBEM-INQU VALUE "INQU". 05 EZECRS-SUBEM-ID PIC S9(4) COMP. 88 EZECRS-SUBEM-CLOS VALUE 0. PROCEDURE DIVISION. *----------------------------------------------------------------- * MAIN PROCESS *----------------------------------------------------------------- EZEMAIN-PROCESS SECTION. PERFORM EZECONTROL GOBACK. *----------------------------------------------------------------- * BEGIN PROCESS *----------------------------------------------------------------- EZEBEGIN-PROCESSES SECTION. CONTINUE. *----------------------------------------------------------------- * SQL PROCESS OPTIONS BYPASS *----------------------------------------------------------------- EZESQL-PROCESS-BYPASS SECTION. GO TO PGGSS1-MAIN. EZESQL-PROCESS-BYPASS-X. EXIT. *----------------------------------------------------------------- * SQL PROCESS OPTIONS * * SQL CLOSE CURSOR AND PROCESS OPTIONS SECTIONS ARE PLACED AT THE * TOP OF THE PROGRAM. * THE SQL PREPROCESSOR DOES NOT PROCESS EXEC SQL STATEMENTS AFTER * 32,767. *----------------------------------------------------------------- *----------------------------------------------------------------- * CLOSE CURSOR FOR SQL ROW BIRIMM *----------------------------------------------------------------- EZECLOSCU-BIRIMM SECTION. MOVE SPACES TO EZECRS-BIRIMM-TYP IF EZECRS-BIRIMM-CLOS GO TO EZECLOSCU-BIRIMM-X END-IF IF EZECRS-BIRIMM-ID = 1 EXEC SQL CLOSE EZE001001PGGSS1 END-EXEC END-IF SET EZECRS-BIRIMM-CLOS TO TRUE MOVE "CLOSE" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE IF EZERTS-PRC-OPT = "CLOSE" OR (SQLCODE NOT = 0 AND EZESQCOD = 0) MOVE SQLCA TO EZESQLCA MOVE EZERTS-SQLERR-STATUS TO EZESTA-BIRIMM-RC END-IF. EZECLOSCU-BIRIMM-X. EXIT. *----------------------------------------------------------------- * CLOSE CURSOR FOR SQL ROW GOREVM *----------------------------------------------------------------- EZECLOSCU-GOREVM SECTION. MOVE SPACES TO EZECRS-GOREVM-TYP IF EZECRS-GOREVM-CLOS GO TO EZECLOSCU-GOREVM-X END-IF IF EZECRS-GOREVM-ID = 1 EXEC SQL CLOSE EZE002001PGGSS1 END-EXEC END-IF SET EZECRS-GOREVM-CLOS TO TRUE MOVE "CLOSE" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE IF EZERTS-PRC-OPT = "CLOSE" OR (SQLCODE NOT = 0 AND EZESQCOD = 0) MOVE SQLCA TO EZESQLCA MOVE EZERTS-SQLERR-STATUS TO EZESTA-GOREVM-RC END-IF. EZECLOSCU-GOREVM-X. EXIT. *----------------------------------------------------------------- * CLOSE CURSOR FOR SQL ROW PERSONEL *----------------------------------------------------------------- EZECLOSCU-PERSONEL SECTION. MOVE SPACES TO EZECRS-PERSONEL-TYP IF EZECRS-PERSONEL-CLOS GO TO EZECLOSCU-PERSONEL-X END-IF IF EZECRS-PERSONEL-ID = 1 EXEC SQL CLOSE EZE003001PGGSS1 END-EXEC END-IF SET EZECRS-PERSONEL-CLOS TO TRUE MOVE "CLOSE" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE IF EZERTS-PRC-OPT = "CLOSE" OR (SQLCODE NOT = 0 AND EZESQCOD = 0) MOVE SQLCA TO EZESQLCA MOVE EZERTS-SQLERR-STATUS TO EZESTA-PERSONEL-RC END-IF. EZECLOSCU-PERSONEL-X. EXIT. *----------------------------------------------------------------- * CLOSE CURSOR FOR SQL ROW SUBEM *----------------------------------------------------------------- EZECLOSCU-SUBEM SECTION. MOVE SPACES TO EZECRS-SUBEM-TYP IF EZECRS-SUBEM-CLOS GO TO EZECLOSCU-SUBEM-X END-IF IF EZECRS-SUBEM-ID = 1 EXEC SQL CLOSE EZE004001PGGSS1 END-EXEC END-IF SET EZECRS-SUBEM-CLOS TO TRUE MOVE "CLOSE" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE IF EZERTS-PRC-OPT = "CLOSE" OR (SQLCODE NOT = 0 AND EZESQCOD = 0) MOVE SQLCA TO EZESQLCA MOVE EZERTS-SQLERR-STATUS TO EZESTA-SUBEM-RC END-IF. EZECLOSCU-SUBEM-X. EXIT. *----------------------------------------------------------------- * INPUT / OUTPUT ROUTINE FOR PROCESS BIRIM_INQ1 *----------------------------------------------------------------- * PROCESS OPTION : INQUIRY * PROCESS OBJECT : BIRIMM *----------------------------------------------------------------- EZEINQU-BIRIM-INQ1 SECTION. MOVE "BIRIM_INQ1" TO EZERTS-PRC-NAME MOVE "INQUIRY" TO EZERTS-PRC-OPT MOVE "BIRIMM" TO EZERTS-PRC-OBJ SET EZERTS-ERROR-ROUTINE TO TRUE MOVE ZEROES TO EZESTA-BIRIMM-RC IF NOT EZECRS-BIRIMM-CLOS PERFORM EZECLOSCU-BIRIMM IF EZESTA-BIRIMM-HRD GO TO EZEINQ-BIRIM-INQ1-ERR END-IF END-IF EXEC SQL OPEN EZE001001PGGSS1 END-EXEC MOVE "OPEN" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE MOVE EZERTS-SQLERR-STATUS TO EZESTA-BIRIMM-RC IF EZESTA-BIRIMM-HRD OR EZESTA-BIRIMM-NRF GO TO EZEINQ-BIRIM-INQ1-ERR END-IF MOVE 1 TO EZECRS-BIRIMM-ID MOVE "INQU" TO EZECRS-BIRIMM-TYP EXEC SQL FETCH EZE001001PGGSS1 INTO :EZESQL-BIRIMM-H.EZEI-2:EZESQL-BIRIMM-I.EZEI-2 END-EXEC MOVE "FETCH" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE MOVE EZERTS-SQLERR-STATUS TO EZESTA-BIRIMM-RC PERFORM EZECLOSCU-BIRIMM. IF EZESTA-BIRIMM-HRD OR EZESTA-BIRIMM-NRF GO TO EZEINQ-BIRIM-INQ1-ERR END-IF. IF EZEI-2 OF EZESQL-BIRIMM-I NEGATIVE MOVE SPACES TO EZEI-2 OF BIRIMM END-IF CONTINUE. EZEINQ-BIRIM-INQ1-ERR. CONTINUE. EZEINQU-BIRIM-INQ1-X. EXIT. *----------------------------------------------------------------- * INPUT / OUTPUT ROUTINE FOR PROCESS GOREV_INQ1 *----------------------------------------------------------------- * PROCESS OPTION : INQUIRY * PROCESS OBJECT : GOREVM *----------------------------------------------------------------- EZEINQU-GOREV-INQ1 SECTION. MOVE "GOREV_INQ1" TO EZERTS-PRC-NAME MOVE "INQUIRY" TO EZERTS-PRC-OPT MOVE "GOREVM" TO EZERTS-PRC-OBJ SET EZERTS-NO-ERROR-ROUTINE TO TRUE MOVE ZEROES TO EZESTA-GOREVM-RC IF NOT EZECRS-GOREVM-CLOS PERFORM EZECLOSCU-GOREVM IF EZESTA-GOREVM-HRD GO TO EZEINQ-GOREV-INQ1-ERR END-IF END-IF EXEC SQL OPEN EZE002001PGGSS1 END-EXEC MOVE "OPEN" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE MOVE EZERTS-SQLERR-STATUS TO EZESTA-GOREVM-RC IF EZESTA-GOREVM-HRD OR EZESTA-GOREVM-NRF GO TO EZEINQ-GOREV-INQ1-ERR END-IF MOVE 1 TO EZECRS-GOREVM-ID MOVE "INQU" TO EZECRS-GOREVM-TYP EXEC SQL FETCH EZE002001PGGSS1 INTO :EZESQL-GOREVM-H.EZEI-6:EZESQL-GOREVM-I.EZEI-6 END-EXEC MOVE "FETCH" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE MOVE EZERTS-SQLERR-STATUS TO EZESTA-GOREVM-RC PERFORM EZECLOSCU-GOREVM. IF EZESTA-GOREVM-HRD OR EZESTA-GOREVM-NRF GO TO EZEINQ-GOREV-INQ1-ERR END-IF. IF EZEI-6 OF EZESQL-GOREVM-I NEGATIVE MOVE SPACES TO EZEI-6 OF GOREVM END-IF CONTINUE. EZEINQ-GOREV-INQ1-ERR. IF EZESTA-GOREVM-ERR SET EZERTS-EZECLOS TO TRUE GO TO EZETERMINATE END-IF CONTINUE. EZEINQU-GOREV-INQ1-X. EXIT. *----------------------------------------------------------------- * INPUT / OUTPUT ROUTINE FOR PROCESS PERSONEL_INQ1 *----------------------------------------------------------------- * PROCESS OPTION : INQUIRY * PROCESS OBJECT : PERSONEL *----------------------------------------------------------------- EZEINQU-PERSONEL-INQ1 SECTION. MOVE "PERSONEL_INQ1" TO EZERTS-PRC-NAME MOVE "INQUIRY" TO EZERTS-PRC-OPT MOVE "PERSONEL" TO EZERTS-PRC-OBJ SET EZERTS-ERROR-ROUTINE TO TRUE MOVE ZEROES TO EZESTA-PERSONEL-RC IF NOT EZECRS-PERSONEL-CLOS PERFORM EZECLOSCU-PERSONEL IF EZESTA-PERSONEL-HRD GO TO EZEINQ-PERSONEL-INQ1-ERR END-IF END-IF EXEC SQL OPEN EZE003001PGGSS1 END-EXEC MOVE "OPEN" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE MOVE EZERTS-SQLERR-STATUS TO EZESTA-PERSONEL-RC IF EZESTA-PERSONEL-HRD OR EZESTA-PERSONEL-NRF GO TO EZEINQ-PERSONEL-INQ1-ERR END-IF MOVE 1 TO EZECRS-PERSONEL-ID MOVE "INQU" TO EZECRS-PERSONEL-TYP EXEC SQL FETCH EZE003001PGGSS1 INTO :EZESQL-PERSONEL-H.EZEI-10:EZESQL-PERSONEL-I.EZEI-10 , :EZESQL-PERSONEL-H.CINSIYET:EZESQL-PERSONEL-I.CINSIYET , :EZESQL-PERSONEL-H.OGRENIM:EZESQL-PERSONEL-I.OGRENIM , :EZESQL-PERSONEL-H.EZEI-11:EZESQL-PERSONEL-I.EZEI-11 , :EZESQL-PERSONEL-H.EZEI-12:EZESQL-PERSONEL-I.EZEI-12 , :EZESQL-PERSONEL-H.EZEI-13:EZESQL-PERSONEL-I.EZEI-13 END-EXEC MOVE "FETCH" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE MOVE EZERTS-SQLERR-STATUS TO EZESTA-PERSONEL-RC PERFORM EZECLOSCU-PERSONEL. IF EZESTA-PERSONEL-HRD OR EZESTA-PERSONEL-NRF GO TO EZEINQ-PERSONEL-INQ1-ERR END-IF. IF EZEI-10 OF EZESQL-PERSONEL-I NEGATIVE MOVE SPACES TO EZEI-10 OF PERSONEL END-IF IF CINSIYET OF EZESQL-PERSONEL-I NEGATIVE MOVE SPACES TO CINSIYET OF PERSONEL END-IF IF OGRENIM OF EZESQL-PERSONEL-I NEGATIVE MOVE SPACES TO OGRENIM OF PERSONEL END-IF IF EZEI-11 OF EZESQL-PERSONEL-I NEGATIVE MOVE SPACES TO EZEI-11 OF PERSONEL END-IF IF EZEI-12 OF EZESQL-PERSONEL-I NEGATIVE MOVE SPACES TO EZEI-12 OF PERSONEL END-IF IF EZEI-13 OF EZESQL-PERSONEL-I NEGATIVE MOVE SPACES TO EZEI-13 OF PERSONEL END-IF CONTINUE. EZEINQ-PERSONEL-INQ1-ERR. CONTINUE. EZEINQU-PERSONEL-INQ1-X. EXIT. *----------------------------------------------------------------- * INPUT / OUTPUT ROUTINE FOR PROCESS SUBE_INQ1 *----------------------------------------------------------------- * PROCESS OPTION : INQUIRY * PROCESS OBJECT : SUBEM *----------------------------------------------------------------- EZEINQU-SUBE-INQ1 SECTION. MOVE "SUBE_INQ1" TO EZERTS-PRC-NAME MOVE "INQUIRY" TO EZERTS-PRC-OPT MOVE "SUBEM" TO EZERTS-PRC-OBJ SET EZERTS-ERROR-ROUTINE TO TRUE MOVE ZEROES TO EZESTA-SUBEM-RC IF NOT EZECRS-SUBEM-CLOS PERFORM EZECLOSCU-SUBEM IF EZESTA-SUBEM-HRD GO TO EZEINQ-SUBE-INQ1-ERR END-IF END-IF EXEC SQL OPEN EZE004001PGGSS1 END-EXEC MOVE "OPEN" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE MOVE EZERTS-SQLERR-STATUS TO EZESTA-SUBEM-RC IF EZESTA-SUBEM-HRD OR EZESTA-SUBEM-NRF GO TO EZEINQ-SUBE-INQ1-ERR END-IF MOVE 1 TO EZECRS-SUBEM-ID MOVE "INQU" TO EZECRS-SUBEM-TYP EXEC SQL FETCH EZE004001PGGSS1 INTO :EZESQL-SUBEM-H.SUBE-AD:EZESQL-SUBEM-I.SUBE-AD END-EXEC MOVE "FETCH" TO EZERTS-SQL-COMMAND PERFORM EZESQL-ERROR-ROUTINE MOVE EZERTS-SQLERR-STATUS TO EZESTA-SUBEM-RC PERFORM EZECLOSCU-SUBEM. IF EZESTA-SUBEM-HRD OR EZESTA-SUBEM-NRF GO TO EZEINQ-SUBE-INQ1-ERR END-IF. IF SUBE-AD OF EZESQL-SUBEM-I NEGATIVE MOVE SPACES TO SUBE-AD OF SUBEM END-IF CONTINUE. EZEINQ-SUBE-INQ1-ERR. CONTINUE. EZEINQU-SUBE-INQ1-X. EXIT. *----------------------------------------------------------------- * MAIN PROCESS : PGGSS1-MAIN * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:30:17 * PROCESS OPTION : EXECUTE *----------------------------------------------------------------- PGGSS1-MAIN SECTION. MOVE "PGGSS1-MAIN" TO EZERTS-PRC-NAME 000001* /* Standard initialization for database operations. 000002* PERFORM SQL-INIT; PERFORM EZEP-SQL-INIT 000003* 000004* /* Initialize Access Type (R=read, W=write). 000005* VDBCONTROL.UACCTYP = 'R'; MOVE "R" TO UACCTYP OF VDBCONTROL 000006* VDBCONTROL.UIOTYPE = 'S'; MOVE "S" TO UIOTYPE OF VDBCONTROL 000007* 000008* /* Store application name 000009* VDBCOMMON.UAPPLNAM = 'PGGSS1'; MOVE "PGGSS1" TO UAPPLNAM OF VDBCOMMON 000010* 000011* /* Store the name of the SQL record in the server common record. 000012* VDBCOMMON.USQLREC = 'PERSONEL'; MOVE "PERSONEL" TO USQLREC OF VDBCOMMON 000013* VDBCOMMON.UTABLNAM = "Personel Bilgileri"; MOVE "Personel Bilgileri" TO UTABLNAM OF VDBCOMMON 000014* 000015* /* search key 000016* PERSONEL.SICIL = WPERSONEL.SICIL; MOVE SICIL OF WPERSONEL TO SICIL OF PERSONEL MOVE ZEROS TO SICIL OF EZESQL-PERSONEL-I 000017* 000018* /* Retrieve the data from table 000019* PERFORM PERSONEL_INQ1; PERFORM PERSONEL-INQ1 000020* 000021* /* Move data to detail record 000022* IF PERSONEL NOT ERR; IF NOT EZESTA-PERSONEL-ERR GO TO EZECONDLBL-1 END-IF GO TO EZECONDLBL-2 CONTINUE. EZECONDLBL-1. 000023* PERFORM PGGSS1-MOVEDATA; PERFORM PGGSS1-MOVEDATA 000024* /* sube adi 000025* SUBEM.SUBE_KOD = PERSONEL.SUBE_KOD; MOVE EZEI-11 OF EZESQL-PERSONEL-I TO SUBE-KOD OF EZESQL-SUBEM-I MOVE EZEI-11 OF PERSONEL TO SUBE-KOD OF SUBEM 000026* PERFORM SUBE_INQ1; PERFORM SUBE-INQ1 000027* WSUBE.SUBE_AD = SUBEM.SUBE_AD; MOVE SUBE-AD OF SUBEM TO EZEI-4 OF WSUBE 000028* /* birim adi 000029* BIRIMM.BIRIM_KOD = PERSONEL.BIRIM_KOD; MOVE EZEI-12 OF EZESQL-PERSONEL-I TO EZEI-1 OF EZESQL-BIRIMM-I MOVE EZEI-12 OF PERSONEL TO EZEI-1 OF BIRIMM 000030* PERFORM BIRIM_INQ1; PERFORM BIRIM-INQ1 000031* WBIRIM.BIRIM_AD = BIRIMM.BIRIM_AD; MOVE EZEI-2 OF BIRIMM TO BIRIM-AD OF WBIRIM 000032* /* gorev adi 000033* GOREVM.GOREV_KOD = PERSONEL.GOREV_KOD; MOVE EZEI-13 OF EZESQL-PERSONEL-I TO EZEI-5 OF EZESQL-GOREVM-I MOVE EZEI-13 OF PERSONEL TO EZEI-5 OF GOREVM 000034* PERFORM GOREV_INQ1; PERFORM GOREV-INQ1 000035* WGOREV.GOREV_AD = GOREVM.GOREV_AD; MOVE EZEI-6 OF GOREVM TO GOREV-AD OF WGOREV CONTINUE. EZECONDLBL-2. 000036* END; 000037* 000038* /* Set error flags. 000039* /* UNRF - no record found flag (Y,N,1) 000040* /* UDUP - duplicate key flag (Y,N) 000041* VDBCOMMON.UNRF = '1'; MOVE "1" TO UNRF OF VDBCOMMON 000042* VDBCOMMON.UDUP = 'N'; MOVE "N" TO UDUP OF VDBCOMMON 000043* 000044* /* Start DBM error processing. 000045* PERFORM SQL-ERROR; PERFORM EZEP-SQL-ERROR CONTINUE. EZE-PGGSS1-MAIN-X. EXIT. *----------------------------------------------------------------- * STRUCTURE LIST POST-PROCESSING *----------------------------------------------------------------- EZESTRUCTURE-FALLTHRU SECTION. GO TO EZETERMINATE. EZESTRUCTURE-FALLTHRU-X. EXIT. *----------------------------------------------------------------- * PROCESS : BIRIM_INQ1 * : BIRIM_INQ1 RENAMED TO BIRIM-INQ1 * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:24:40 * PROCESS OPTION : INQUIRY * PROCESS OBJECT : BIRIMM *----------------------------------------------------------------- BIRIM-INQ1 SECTION. MOVE "BIRIM_INQ1" TO EZERTS-PRC-NAME PERFORM EZEINQU-BIRIM-INQ1 CONTINUE. EZE-BIRIM-INQ1-X. EXIT. *----------------------------------------------------------------- * PROCESS : GOREV_INQ1 * : GOREV_INQ1 RENAMED TO GOREV-INQ1 * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:28:40 * PROCESS OPTION : INQUIRY * PROCESS OBJECT : GOREVM *----------------------------------------------------------------- GOREV-INQ1 SECTION. MOVE "GOREV_INQ1" TO EZERTS-PRC-NAME PERFORM EZEINQU-GOREV-INQ1 CONTINUE. EZE-GOREV-INQ1-X. EXIT. *----------------------------------------------------------------- * PROCESS : PERSONEL_INQ1 * : PERSONEL_INQ1 RENAMED TO PERSONEL-INQ1 * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:08:21 * PROCESS OPTION : INQUIRY * PROCESS OBJECT : PERSONEL *----------------------------------------------------------------- PERSONEL-INQ1 SECTION. MOVE "PERSONEL_INQ1" TO EZERTS-PRC-NAME PERFORM EZEINQU-PERSONEL-INQ1 CONTINUE. EZE-PERSONEL-INQ1-X. EXIT. *----------------------------------------------------------------- * PROCESS : PGGSS1-MOVEDATA * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:09:18 * PROCESS OPTION : EXECUTE *----------------------------------------------------------------- PGGSS1-MOVEDATA SECTION. MOVE "PGGSS1-MOVEDATA" TO EZERTS-PRC-NAME 000055* WPERSONEL = PERSONEL; MOVE SICIL OF PERSONEL TO SICIL OF WPERSONEL MOVE EZEI-10 OF PERSONEL TO AD-SOYAD OF WPERSONEL MOVE CINSIYET OF PERSONEL TO CINSIYET OF WPERSONEL MOVE OGRENIM OF PERSONEL TO OGRENIM OF WPERSONEL MOVE EZEI-11 OF PERSONEL TO EZEI-7 OF WPERSONEL MOVE EZEI-12 OF PERSONEL TO EZEI-8 OF WPERSONEL MOVE EZEI-13 OF PERSONEL TO EZEI-9 OF WPERSONEL CONTINUE. EZE-PGGSS1-MOVEDATA-X. EXIT. *----------------------------------------------------------------- * PROCESS : SQL-ERROR * : SQL-ERROR RENAMED TO EZEP-SQL-ERROR * MODIFICATION DATE : 01.06.2000 * MODIFICATION TIME : 10:43:35 * PROCESS OPTION : EXECUTE * DESCRIPTION : std. SQL error handler *----------------------------------------------------------------- EZEP-SQL-ERROR SECTION. MOVE "SQL-ERROR" TO EZERTS-PRC-NAME 000056* /* *********************************************************** 000057* /* * Process : SQL-ERROR 000058* /* * 000059* /* * Function : Reusable standard SQL error handling process. 000060* /* * 000061* /* ************************************************************ 000062* /* ----------------------------------------------------------- 000063* /* This process handles SQL errors. Depending on the values 000064* /* in EZESQLCOD, VDBCONTROL.URC and the UNRF and UDUP flags, 000065* /* the need of a ROLLBACK is required. 000066* /* 000067* /* ROLLBACK in only necessary when action type is 000068* /* UACCTYP = 'W'. Both COMMIT and ROLLBACK will have to 000069* /* be issued from the calling application (umbrella). 000070* /* 000071* /* Condition UNRF UDUP URC Commit or Rollback 000072* /* ========= ==== ==== === ================== 000073* /* EZESQCOD=0 * * 0 COMMIT 000074* /* EZESQCOD=100 Y * 100 ROLLBACK 000075* /* EZESQCOD=100 N * 0 COMMIT 000076* /* EZESQCOD=100 1 * 100 ROLLBACK (if UROWR = 0) 000077* /* 0 COMMIT (if UROWR > 0) 000078* /* EZESQCOD=-803 * Y 104 ROLLBACK 000079* /* EZESQCOD=-803 * N 0 COMMIT 000080* /* EZESQCOD=-911 * * 108 ROLLBACK 000081* /* other SQL error * * 112 ROLLBACK 000082* 000083* /* In case an SQL error occurred: 000084* IF EZESQCOD NE 0 000085* AND VDBCONTROL.URC EQ 0; IF EZESQCOD NOT = 0 AND URC OF VDBCONTROL = 0 000086* 000087* /* No Record Found error (NRF) 000088* IF EZESQCOD EQ 100; IF EZESQCOD = 100 000089* IF VDBCONTROL.UIOTYPE EQ "D"; IF UIOTYPE OF VDBCONTROL = "D" 000090* /* Delete failed: row not found 000091* VMESSAGE.UMSGCODE = 'SQL0100D'; MOVE "SQL0100D" TO UMSGCODE OF VMESSAGE 000092* VDBCONTROL.URC = 1; MOVE 1 TO URC OF VDBCONTROL CALL "ELAFXNUM" USING URC OF VDBCONTROL(LENGTH OF URC OF VDBCONTROL:1) 000093* ELSE; ELSE 000094* IF VDBCONTROL.UIOTYPE EQ "U"; IF UIOTYPE OF VDBCONTROL = "U" 000095* /* Update failed: row not found 000096* VMESSAGE.UMSGCODE = 'SQL0100U'; MOVE "SQL0100U" TO UMSGCODE OF VMESSAGE 000097* VDBCONTROL.URC = 1; MOVE 1 TO URC OF VDBCONTROL CALL "ELAFXNUM" USING URC OF VDBCONTROL(LENGTH OF URC OF VDBCONTROL:1) 000098* ELSE; ELSE 000099* IF VDBCOMMON.UNRF EQ 'Y'; IF UNRF OF VDBCOMMON = "Y" 000100* /* Read failed: row not found 000101* VDBCONTROL.URC = 100; MOVE 100 TO URC OF VDBCONTROL CALL "ELAFXNUM" USING URC OF VDBCONTROL(LENGTH OF URC OF VDBCONTROL:1) 000102* VMESSAGE.UMSGCODE = 'SQL0100'; MOVE "SQL0100" TO UMSGCODE OF VMESSAGE 000103* ELSE; ELSE 000104* IF VDBCOMMON.UNRF EQ '1'; IF UNRF OF VDBCOMMON = "1" 000105* IF VDBCONTROL.UROWR EQ 0; IF UROWR OF VDBCONTROL = 0 000106* /* No rows read: NRF error 000107* VDBCONTROL.URC = 100; MOVE 100 TO URC OF VDBCONTROL CALL "ELAFXNUM" USING URC OF VDBCONTROL(LENGTH OF URC OF VDBCONTROL:1) 000108* VMESSAGE.UMSGCODE = 'SQL0100'; MOVE "SQL0100" TO UMSGCODE OF VMESSAGE 000109* END; END-IF 000110* END; END-IF 000111* END; END-IF 000112* END; END-IF 000113* END; END-IF 000114* ELSE; /* Other errors ELSE 000115* /* duplicate key error (DUP) 000116* IF EZESQCOD EQ -803; IF EZESQCOD = -803 000117* IF VDBCOMMON.UDUP EQ 'Y'; IF UDUP OF VDBCOMMON = "Y" 000118* VDBCONTROL.URC = 104; MOVE 104 TO URC OF VDBCONTROL CALL "ELAFXNUM" USING URC OF VDBCONTROL(LENGTH OF URC OF VDBCONTROL:1) 000119* VMESSAGE.UMSGCODE = 'SQL0803'; MOVE "SQL0803" TO UMSGCODE OF VMESSAGE 000120* END; END-IF 000121* ELSE; ELSE 000122* /* deadlock/timeout error 000123* IF EZESQCOD EQ -911 000124* OR EZESQCOD EQ -913; IF EZESQCOD = -911 OR EZESQCOD = -913 000125* VDBCONTROL.URC = 108; MOVE 108 TO URC OF VDBCONTROL CALL "ELAFXNUM" USING URC OF VDBCONTROL(LENGTH OF URC OF VDBCONTROL:1) 000126* VMESSAGE.UMSGCODE = 'SQL0913'; MOVE "SQL0913" TO UMSGCODE OF VMESSAGE 000127* ELSE; ELSE 000128* IF EZESQCOD EQ -532; IF EZESQCOD = -532 000129* VDBCONTROL.URC = 108; MOVE 108 TO URC OF VDBCONTROL CALL "ELAFXNUM" USING URC OF VDBCONTROL(LENGTH OF URC OF VDBCONTROL:1) 000130* VMESSAGE.UMSGCODE = 'SQL0532'; MOVE "SQL0532" TO UMSGCODE OF VMESSAGE 000131* ELSE; ELSE 000132* IF EZESQCOD EQ -530; IF EZESQCOD = -530 000133* VDBCONTROL.URC = 108; MOVE 108 TO URC OF VDBCONTROL CALL "ELAFXNUM" USING URC OF VDBCONTROL(LENGTH OF URC OF VDBCONTROL:1) 000134* VMESSAGE.UMSGCODE = 'SQL0530'; MOVE "SQL0530" TO UMSGCODE OF VMESSAGE 000135* ELSE; ELSE 000136* /* Other SQL error 000137* IF EZESQCOD LT 0; IF EZESQCOD < 0 000138* VDBCONTROL.URC = 112; MOVE 112 TO URC OF VDBCONTROL CALL "ELAFXNUM" USING URC OF VDBCONTROL(LENGTH OF URC OF VDBCONTROL:1) 000139* VMESSAGE.UMSGCODE = 'SQL9999'; MOVE "SQL9999" TO UMSGCODE OF VMESSAGE 000140* END; END-IF 000141* END; END-IF 000142* END; END-IF 000143* END; /* deadlock/timeout error END-IF 000144* END; /* DUP error END-IF 000145* END; /* NRF error END-IF 000146* 000147* /* When URC contains a value, move the EZESQCOD 000148* /* to the message insert field. 000149* IF VDBCONTROL.URC EQ 112 000150* OR VDBCONTROL.URC EQ 108; IF URC OF VDBCONTROL = 112 OR URC OF VDBCONTROL = 108 000151* 000152* /* Move SQL error number to number item. 000153* VDBCOMMON.USQLNUM = EZESQCOD; COMPUTE USQLNUM OF VDBCOMMON = EZESQCOD ON SIZE ERROR MOVE "SQL-ERROR" TO EZERTS-PRC-NAME MOVE 153 TO EZERTS-PRC-NUM PERFORM EZEOVER-ROUTINE END-COMPUTE CALL "ELAFXNUM" USING USQLNUM OF VDBCOMMON(LENGTH OF USQLNUM OF VDBCOMMON:1) 000154* 000155* /* Set SQL code sign. 000156* IF VDBCOMMON.USQLNUM LT 0; IF USQLNUM OF VDBCOMMON < 0 000157* VDBCOMMON.USIGN = '-'; MOVE "-" TO USIGN OF VDBCOMMON 000158* VDBCOMMON.USQLNUM = VDBCOMMON.USQLNUM * -1; COMPUTE USQLNUM OF VDBCOMMON = USQLNUM OF VDBCOMMON * -1 ON SIZE ERROR MOVE "SQL-ERROR" TO EZERTS-PRC-NAME MOVE 158 TO EZERTS-PRC-NUM PERFORM EZEOVER-ROUTINE END-COMPUTE CALL "ELAFXNUM" USING USQLNUM OF VDBCOMMON(LENGTH OF USQLNUM OF VDBCOMMON:1) 000159* ELSE; ELSE 000160* VDBCOMMON.USIGN = '+'; MOVE "+" TO USIGN OF VDBCOMMON 000161* END; /* Set SQL code sign. END-IF 000162* 000163* /* Move SQL error number to character item. 000164* VDBCOMMON.USQLCHA = VDBCOMMON.USQLNUM; MOVE USQLNUM OF VDBCOMMON(1:LENGTH OF USQLNUM OF VDBCOMMON) TO USQLCHA OF VDBCOMMON 000165* 000166* /* Move SQL error number to message insert. 000167* VMESSAGE.UMSGINS(1) = VDBCOMMON.UEZESQCD; MOVE UEZESQCD OF VDBCOMMON TO UMSGINS OF VMESSAGE (1) 000168* 000169* END; END-IF 000170* END; /* SQL error occurred. END-IF 000171* 000172* 000173* /* When error occurred: 000174* IF VDBCONTROL.URC NE 0; IF URC OF VDBCONTROL NOT = 0 000175* 000176* /* Store SQL message inserts. 000177* VDBCONTROL.UEZESQRRM = EZESQRRM; MOVE EZESQRRM TO UEZESQRRM OF VDBCONTROL 000178* 000179* /* Move applicationame to message insert. 000180* IF VMESSAGE.UMSGINS(1) EQ ' '; IF UMSGINS OF VMESSAGE (1) = " " 000181* VMESSAGE.UMSGINS(1) = VDBCOMMON.UPROCNAM; MOVE UPROCNAM OF VDBCOMMON TO UMSGINS OF VMESSAGE (1) 000182* END; END-IF 000183* 000184* /* Move applicationame to message insert. 000185* IF VMESSAGE.UMSGINS(2) EQ ' '; IF UMSGINS OF VMESSAGE (2) = " " 000186* VMESSAGE.UMSGINS(2) = VDBCOMMON.UAPPLNAM; MOVE UAPPLNAM OF VDBCOMMON TO UMSGINS OF VMESSAGE (2) 000187* END; END-IF 000188* 000189* /* Move tablename to message insert. 000190* IF VMESSAGE.UMSGINS(3) EQ ' '; IF UMSGINS OF VMESSAGE (3) = " " 000191* VMESSAGE.UMSGINS(3) = VDBCOMMON.UTABLNAM; MOVE UTABLNAM OF VDBCOMMON TO UMSGINS OF VMESSAGE (3) 000192* END; END-IF 000193* 000194* /* Determine if rollback is required 000195* IF VDBCONTROL.UACCTYP EQ 'W' 000196* AND VDBCONTROL.UROWW GE 1; IF UACCTYP OF VDBCONTROL = "W" AND UROWW OF VDBCONTROL >= 1 000197* VDBCONTROL.UROLLBACK = 'Y'; MOVE "Y" TO UROLLBACK OF VDBCONTROL 000198* END; /* Rollback required. END-IF 000199* END; /* Error detected. END-IF CONTINUE. EZE-EZEP-SQL-ERROR-X. EXIT. *----------------------------------------------------------------- * PROCESS : SQL-INIT * : SQL-INIT RENAMED TO EZEP-SQL-INIT * MODIFICATION DATE : 01.06.2000 * MODIFICATION TIME : 10:44:07 * PROCESS OPTION : EXECUTE * DESCRIPTION : std. SQL initialization *----------------------------------------------------------------- EZEP-SQL-INIT SECTION. MOVE "SQL-INIT" TO EZERTS-PRC-NAME 000200* /* ************************************************************ 000201* /* * Proces : SQL-INIT 000202* /* * 000203* /* * Function : This process initializes the record items 000204* /* * used in applications which perform SQL 000205* /* * queries. 000206* /* * 000207* /* ************************************************************ 000208* 000209* /* Return SQL hard errors. 000210* EZEFEC = 1; MOVE 1 TO EZEFEC CALL "ELAFXNUM" USING EZEFEC(LENGTH OF EZEFEC:1) 000211* 000212* /* Initialize common data items used for control 000213* /* and error handling. 000214* VDBCONTROL.URC = 0; MOVE 0 TO URC OF VDBCONTROL CALL "ELAFXNUM" USING URC OF VDBCONTROL(LENGTH OF URC OF VDBCONTROL:1) 000215* VDBCONTROL.UROLLBACK = 'N'; MOVE "N" TO UROLLBACK OF VDBCONTROL 000216* VDBCONTROL.UNRF = 'N'; MOVE "N" TO UNRF OF VDBCONTROL 000217* 000218* VDBCONTROL.UACCTYP = ' '; MOVE " " TO UACCTYP OF VDBCONTROL 000219* VDBCONTROL.UACCSAV = ' '; MOVE " " TO UACCSAV OF VDBCONTROL 000220* VDBCONTROL.UROWR = 0; MOVE 0 TO UROWR OF VDBCONTROL 000221* VDBCONTROL.UROWW = 0; MOVE 0 TO UROWW OF VDBCONTROL 000222* VDBCONTROL.UEZESQRRM = ' '; MOVE " " TO UEZESQRRM OF VDBCONTROL 000223* 000224* SET VDBCOMMON EMPTY; PERFORM EZESETEMP-VDBCOMMON 000225* 000226* LOW-VALUE = ' '; MOVE " " TO EZEI-LOW-VALUE OF VDBCONTROL 000227* IF EZESYS IS ITF; IF EZESYS-ITF 000228* HIGH-VALUE = 'Z'; MOVE "Z" TO EZEI-HIGH-VALUE OF VDBCONTROL 000229* ELSE; ELSE 000230* HIGH-VALUE = '9'; MOVE "9" TO EZEI-HIGH-VALUE OF VDBCONTROL 000231* END; END-IF 000232* CONTINUE. EZE-EZEP-SQL-INIT-X. EXIT. *----------------------------------------------------------------- * PROCESS : SUBE_INQ1 * : SUBE_INQ1 RENAMED TO SUBE-INQ1 * MODIFICATION DATE : 02.06.2000 * MODIFICATION TIME : 15:20:11 * PROCESS OPTION : INQUIRY * PROCESS OBJECT : SUBEM *----------------------------------------------------------------- SUBE-INQ1 SECTION. MOVE "SUBE_INQ1" TO EZERTS-PRC-NAME PERFORM EZEINQU-SUBE-INQ1 CONTINUE. EZE-SUBE-INQ1-X. EXIT. *----------------------------------------------------------------- * SQL ERROR ROUTINE *----------------------------------------------------------------- EZESQL-ERROR-ROUTINE SECTION. SET EZERTS-SQL-USED TO TRUE IF EZERTS-SQL-COMMAND NOT = "CLOSE" MOVE SQLCA TO EZESQLCA END-IF IF SQLCODE = 0 MOVE 0 TO EZERTS-SQLERR-STATUS ELSE MOVE EZERTS-SQLERR TO EZERTS-SQLERR-SVCS-NUM CALL "ELARSVCS" USING EZERTS-CONTROL-BLOCK EZERTS-SQLERR-REQUEST-BLOCK SQLCA IF EZERTS-TERMINATE AND EZECTL-NOT-IN-EZETERMINATE GO TO EZETERMINATE END-IF END-IF. EZESQL-ERROR-ROUTINE-X. EXIT. *----------------------------------------------------------------- * SET EMPTY FOR RECORD BIRIMM *----------------------------------------------------------------- EZESETEMP-BIRIMM SECTION. MOVE LOW-VALUES TO BIRIMM OF EZESTA-BIRIMM-GP MOVE SPACES TO EZEI-1 OF BIRIMM MOVE SPACES TO EZEI-2 OF BIRIMM CONTINUE. EZESETEMP-BIRIMM-X. EXIT. *----------------------------------------------------------------- * SET EMPTY FOR RECORD GOREVM *----------------------------------------------------------------- EZESETEMP-GOREVM SECTION. MOVE LOW-VALUES TO GOREVM OF EZESTA-GOREVM-GP MOVE SPACES TO EZEI-5 OF GOREVM MOVE SPACES TO EZEI-6 OF GOREVM CONTINUE. EZESETEMP-GOREVM-X. EXIT. *----------------------------------------------------------------- * SET EMPTY FOR RECORD PERSONEL *----------------------------------------------------------------- EZESETEMP-PERSONEL SECTION. MOVE LOW-VALUES TO PERSONEL OF EZESTA-PERSONEL-GP MOVE SPACES TO SICIL OF PERSONEL MOVE SPACES TO EZEI-10 OF PERSONEL MOVE SPACES TO CINSIYET OF PERSONEL MOVE SPACES TO OGRENIM OF PERSONEL MOVE SPACES TO EZEI-11 OF PERSONEL MOVE SPACES TO EZEI-12 OF PERSONEL MOVE SPACES TO EZEI-13 OF PERSONEL CONTINUE. EZESETEMP-PERSONEL-X. EXIT. *----------------------------------------------------------------- * SET EMPTY FOR RECORD SUBEM *----------------------------------------------------------------- EZESETEMP-SUBEM SECTION. MOVE LOW-VALUES TO SUBEM OF EZESTA-SUBEM-GP MOVE SPACES TO SUBE-KOD OF SUBEM MOVE SPACES TO SUBE-AD OF SUBEM CONTINUE. EZESETEMP-SUBEM-X. EXIT. *----------------------------------------------------------------- * SET EMPTY FOR RECORD VDBCOMMON *----------------------------------------------------------------- EZESETEMP-VDBCOMMON SECTION. INITIALIZE VDBCOMMON OF EZEWS-VDBCOMMON-GP MOVE SPACES TO USYSID1 OF VDBCOMMON MOVE SPACES TO UAPPLID OF VDBCOMMON MOVE SPACES TO UAPPLSFX OF VDBCOMMON CALL "ELAFXNUM" USING USQLNUM OF VDBCOMMON(LENGTH OF USQLNUM OF VDBCOMMON:1) MOVE SPACES TO USIGN OF VDBCOMMON MOVE SPACES TO USQLCHA OF VDBCOMMON CONTINUE. EZESETEMP-VDBCOMMON-X. EXIT. *----------------------------------------------------------------- * TERMINATION LOGIC *----------------------------------------------------------------- EZETERMINATE SECTION. SET EZECTL-IN-EZETERMINATE TO TRUE. MOVE "EZETERMINATE" TO EZERTS-PRC-NAME PERFORM EZERESRC-SCHEDULE GO TO EZERUN-PROCESSES-X. *----------------------------------------------------------------- * ARITHMETIC OVERFLOW ROUTINE *----------------------------------------------------------------- EZEOVER-ROUTINE SECTION. MOVE 1 TO EZEOVERS IF EZEOVER-TERMINATE MOVE 0009 TO EZERTS-ERROR-NUM CALL "ELARSVCS" USING EZERTS-CONTROL-BLOCK EZERTS-ERROR-REQUEST-BLOCK GO TO EZETERMINATE END-IF. EZEOVER-ROUTINE-X. EXIT. *----------------------------------------------------------------- * MAXIMUM VALUE OVERFLOW ROUTINE *----------------------------------------------------------------- EZEOVER-MAX-VALUE-ROUTINE SECTION. MOVE 1 TO EZEOVERS IF EZEOVER-DEFAULT OR EZEOVER-TERMINATE MOVE 0026 TO EZERTS-ERROR-NUM CALL "ELARSVCS" USING EZERTS-CONTROL-BLOCK EZERTS-ERROR-REQUEST-BLOCK GO TO EZETERMINATE END-IF. EZEOVER-MAX-VALUE-ROUTINE-X. EXIT. *----------------------------------------------------------------- * CALLED APPLICATION CONTROL LOGIC *----------------------------------------------------------------- EZECONTROL SECTION. MOVE EIBFN TO EZEAPP-ENTRY-FUNCTION EXEC CICS IGNORE CONDITION ERROR END-EXEC CALL "ELARSTWA" USING DFHEIBLK DFHCOMMAREA EZEAPP-PROFILE SET ADDRESS OF EZERTS-CONTROL-BLOCK TO EZEAPP-RTS-PTR EXEC CICS HANDLE ABEND PROGRAM("ELAESABD") END-EXEC SET EZEPARM-MAPS-INVALID TO TRUE IF NOT EZERTS-SET MOVE "EZEINITIALIZE" TO EZERTS-PRC-NAME MOVE EZEAPP-APPL-NAME TO EZERTS-PGM-NAME SET EZEAPP-CALLER-PROFILE TO NULL CALL "ELAASADR" USING EZEAPP-PROFILE EZERTS-INIT-PROFILE ELSE MOVE "EZEINITIALIZE" TO EZERTS-PRC-NAME MOVE EZERTS-PGM-NAME TO EZECALLER MOVE EZEAPP-APPL-NAME TO EZERTS-PGM-NAME SET EZEAPP-CALLER-PROFILE TO EZERTS-CURR-PROFILE MOVE EZEDLPSB TO EZECTL-HOLD-EZEDLPSB IF EZERTS-TERMINATE CALL "ELAASADR" USING EZEAPP-PROFILE EZERTS-CURR-PROFILE SET EZECTL-IN-EZETERMINATE TO TRUE PERFORM EZEAPPL-IDENTIFY PERFORM EZEEXTERNAL-INITIALIZATION PERFORM EZERESRC-CLEANUP SET EZERTS-CURR-PROFILE TO EZEAPP-CALLER-PROFILE MOVE EZECALLER TO EZERTS-PGM-NAME GO TO EZECONTROL-X END-IF END-IF MOVE EZERTS-CTL-MODE TO EZECTL-HOLD-CTL-MODE MOVE EZERTS-CTL-REQUEST TO EZECTL-HOLD-CTL-REQUEST MOVE EZESEGTR TO EZESEGTR-SAVE MOVE SPACES TO EZESEGTR PERFORM EZEAPPL-IDENTIFY PERFORM EZEINITIALIZE-STORAGE PERFORM EZEREFRESH-STORAGE IF NOT EZERTS-TERMINATE-ON-ERROR AND EZEAPP-ENTRY-FUNCTION NOT = X"0E04" AND NOT EZERTS-ENTRY-FROM-TSMODULE PERFORM EZERECEIVE-COMMAREA-PARMS END-IF IF NOT EZERTS-TERMINATE-ON-ERROR PERFORM EZEEXTERNAL-INITIALIZATION END-IF IF NOT EZERTS-TERMINATE-ON-ERROR PERFORM EZERUN-PROCESSES END-IF IF EZEAPP-CALLER-PROFILE = NULL OR EZEAPP-ENTRY-FUNCTION = X"0E04" OR EZERTS-ENTRY-FROM-TSMODULE SET EZEAPP-CALLER-PROFILE TO NULL IF EZERTS-TERMINATE-ON-ERROR PERFORM EZEREPORT-ERRS-ON-TERMINATN END-IF PERFORM EZECICS-RTS-TERMINATE ELSE SET EZERTS-CURR-PROFILE TO EZEAPP-CALLER-PROFILE MOVE EZECALLER TO EZERTS-PGM-NAME MOVE EZESEGTR-SAVE TO EZESEGTR IF NOT EZERTS-TERMINATE MOVE EZECTL-HOLD-CTL-MODE TO EZERTS-CTL-MODE MOVE EZECTL-HOLD-CTL-REQUEST TO EZERTS-CTL-REQUEST END-IF MOVE EZECTL-HOLD-EZEDLPSB TO EZEDLPSB END-IF. EZECONTROL-X. EXIT. *----------------------------------------------------------------- * IDENTIFY APPLICATION *----------------------------------------------------------------- EZEAPPL-IDENTIFY SECTION. IF NOT EZERTS-SET MOVE SPACES TO EZELTERM MOVE ALL "*" TO EZEUSR EZEUSRID END-IF SET EZEAPP-CURS-BLK-PTR TO NULL SET EZEAPP-LAST-MAPBUF-PTR TO NULL SET EZEAPP-FIRST-MAPBUF-PTR TO NULL SET EZEAPP-ROWS-USED-PTR TO NULL SET EZEAPP-MAPG-MOD-PTR TO NULL SET EZEAPP-HELPG-MOD-PTR TO NULL CALL "ELAASADR" USING EZEWORDS EZEAPP-EZE-WORDS-PTR CALL "ELAASADR" USING EZEPARM-VALIDATION EZEAPP-PARM-VAL-PTR CALL "ELAASADR" USING EZEAPP-PROFILE EZERTS-CURR-PROFILE. EZEAPPL-IDENTIFY-X. EXIT. *----------------------------------------------------------------- * INITIALIZE STORAGE *----------------------------------------------------------------- EZEINITIALIZE-STORAGE SECTION. MOVE SPACES TO EZEWORDS-I MOVE ZERO TO EZECNVCM MOVE ZERO TO EZEFEC EZERCODE MOVE ZERO TO EZEDLERR EZESQISL EZEOVER EZEOVERS MOVE SPACES TO EZEDLPSB IF EZESEGTR = LOW-VALUES MOVE EIBTRNID TO EZESEGTR END-IF MOVE EIBTRMID TO EZELTERM EZEUSR SET EZESEGM-DEFINED TO TRUE MOVE SPACES TO EZEDESTP MOVE "N" TO EZEAPP-EZEDESTP-DIFF MOVE "N" TO EZEAPP-EZEDESTP-CHANGED MOVE 0 TO EZESTA-BIRIMM-RC PERFORM EZESETEMP-BIRIMM MOVE 0 TO EZESTA-GOREVM-RC PERFORM EZESETEMP-GOREVM MOVE 0 TO EZESTA-PERSONEL-RC PERFORM EZESETEMP-PERSONEL MOVE 0 TO EZESTA-SUBEM-RC PERFORM EZESETEMP-SUBEM PERFORM EZESETEMP-VDBCOMMON CONTINUE. EZEINITIALIZE-STORAGE-X. EXIT. *----------------------------------------------------------------- * REFRESH STORAGE - ONLY THESE FIELDS ARE RESET ACROSS CONVERSE *----------------------------------------------------------------- EZEREFRESH-STORAGE SECTION. MOVE ZERO TO EZEDLCER EZEDLCON MOVE ZERO TO EZETST EZEDLLEV EZEDLSSG MOVE ZERO TO EZEMNO EZEDLKYL MOVE SPACES TO EZEDLSTC EZEDLDBD EZEDLKEY EZEDLPRO EZEDLSEG MOVE SPACES TO EZEMSG OF EZEWORDS MOVE "N" TO EZEMNO-MSG-FILE-SW MOVE LOW-VALUES TO EZESQLCA MOVE "SQLCA" TO EZESQNAM MOVE +136 TO EZESQABC MOVE ZERO TO EZESQCOD EZESQRRL MOVE ZERO TO EZESQRD1 EZESQRD2 EZESQRD3 MOVE ZERO TO EZESQRD4 EZESQRD5 EZESQRD6 IF NOT EZERTS-SET OR NOT EZERTS-TERMINATE MOVE SPACES TO EZERTS-DXFR-APPLID SET EZERTS-XFER-MAP-PTR TO NULL SET EZERTS-DXFR-XFER-REC-PTR TO NULL MOVE ZERO TO EZERTS-DXFR-XFER-REC-LEN END-IF. EZEREFRESH-STORAGE-X. EXIT. *----------------------------------------------------------------- * RTS INITIALIZATION *----------------------------------------------------------------- EZEEXTERNAL-INITIALIZATION SECTION. CALL "ELARSINT" USING EZERTS-CONTROL-BLOCK IF EZERTS-TERMINATE-ON-ERROR AND EZECTL-NOT-IN-EZETERMINATE GO TO EZEEXTERNAL-INITIALIZATION-X END-IF SET ADDRESS OF EZEIOP-NLS-INDEP-CTL-BLOCK TO EZERTS-IOP-TABLE-PTR SET ADDRESS OF EZEIOE-NLS-DEP-CTL-BLOCK TO EZERTS-DOP-TABLE-PTR SET ADDRESS OF EZECRS-CURSOR-BLOCKS TO EZEAPP-CURS-BLK-PTR IF NOT EZERTS-TERMINATE SET EZERTS-EXECUTE TO TRUE END-IF. EZEEXTERNAL-INITIALIZATION-X. EXIT. *----------------------------------------------------------------- * RUN APPLICATION PROCESSES *----------------------------------------------------------------- EZERUN-PROCESSES SECTION. SET EZECTL-NOT-IN-EZETERMINATE TO TRUE GO TO EZEBEGIN-PROCESSES. EZERUN-PROCESSES-X. EXIT. *----------------------------------------------------------------- * REPORT THE ERRORS *----------------------------------------------------------------- EZEREPORT-ERRS-ON-TERMINATN SECTION. IF NOT EZERTS-ROLLBACK-TAKEN SET EZERTS-ROLLBACK-TAKEN TO TRUE MOVE EZERTS-ROLLBACK TO EZERTS-SVCS-NUM CALL "ELARSVCS" USING EZERTS-CONTROL-BLOCK EZERTS-REQUEST-BLOCK END-IF IF EZERTS-TERMINAL-ATTACHED MOVE EZERTS-DISPLAY-ERROR-MAP TO EZERTS-SVCS-NUM CALL "ELARSVCS" USING EZERTS-CONTROL-BLOCK EZERTS-REQUEST-BLOCK END-IF CONTINUE. EZEREPORT-ERRS-ON-TERMINATN-X. EXIT. *----------------------------------------------------------------- * RECEIVE PARAMETERS THAT WERE PASSED IN THE COMMAREA *----------------------------------------------------------------- EZERECEIVE-COMMAREA-PARMS SECTION. IF EIBCALEN < 4 OR (DFHCOMMAREA(EIBCALEN - 3:4) = HIGH-VALUES AND EIBCALEN NOT = 28) OR (DFHCOMMAREA(EIBCALEN - 3:4) NOT = HIGH-VALUES AND EIBCALEN NOT = 24) IF NOT EZERTS-SET CALL "ELARSINT" USING EZERTS-CONTROL-BLOCK END-IF IF NOT EZERTS-TERMINATE MOVE 32 TO EZERTS-ERROR-NUM CALL "ELARSVCS" USING EZERTS-CONTROL-BLOCK EZERTS-ERROR-REQUEST-BLOCK END-IF GO TO EZERECEIVE-COMMAREA-PARMS-X END-IF SET ADDRESS OF EZERCD-WPERSONEL-GP TO EZECOMMAREA-PTR(1) SET ADDRESS OF EZERCD-WSUBE-GP TO EZECOMMAREA-PTR(2) SET ADDRESS OF EZERCD-WBIRIM-GP TO EZECOMMAREA-PTR(3) SET ADDRESS OF EZERCD-WGOREV-GP TO EZECOMMAREA-PTR(4) SET ADDRESS OF EZERCD-VDBCONTROL-GP TO EZECOMMAREA-PTR(5) SET ADDRESS OF EZERCD-VMESSAGE-GP TO EZECOMMAREA-PTR(6) CONTINUE. EZERECEIVE-COMMAREA-PARMS-X. EXIT. *----------------------------------------------------------------- * CANCEL CLEAN-UP IF ALL RESOURCES ARE CLOSED *----------------------------------------------------------------- EZERESRC-SCHEDULE SECTION. MOVE "EZERESRC-SCHED" TO EZERTS-PRC-NAME IF EZEAPP-CALLER-PROFILE IS EQUAL TO NULL PERFORM EZERESRC-CLEANUP GO TO EZERESRC-SCHEDULE-X END-IF IF EZECRS-BIRIMM-CLOS AND EZECRS-GOREVM-CLOS AND EZECRS-PERSONEL-CLOS AND EZECRS-SUBEM-CLOS MOVE EZERTS-UNSCHEDULE TO EZERTS-SVCS-NUM CALL "ELARSVCS" USING EZERTS-CONTROL-BLOCK EZERTS-REQUEST-BLOCK END-IF CONTINUE. EZERESRC-SCHEDULE-X. EXIT. *----------------------------------------------------------------- * RESOURCE CLEAN-UP ROUTINE *----------------------------------------------------------------- EZERESRC-CLEANUP SECTION. SET EZECTL-IN-EZETERMINATE TO TRUE MOVE "EZERESRC-CLEAN" TO EZERTS-PRC-NAME PERFORM EZERESRC-CLOSE-CURSORS CONTINUE. EZERESRC-CLEANUP-X. EXIT. *----------------------------------------------------------------- * RESOURCE CLEAN-UP / CLOSE ALL OPEN CURSORS *----------------------------------------------------------------- EZERESRC-CLOSE-CURSORS SECTION. IF NOT EZECRS-BIRIMM-CLOS PERFORM EZECLOSCU-BIRIMM END-IF IF NOT EZECRS-GOREVM-CLOS PERFORM EZECLOSCU-GOREVM END-IF IF NOT EZECRS-PERSONEL-CLOS PERFORM EZECLOSCU-PERSONEL END-IF IF NOT EZECRS-SUBEM-CLOS PERFORM EZECLOSCU-SUBEM END-IF CONTINUE. EZERESRC-CLOSE-CURSORS-X. EXIT. EZECICS-RTS-TERMINATE SECTION. CALL "ELAASTRM" USING EZERTS-CONTROL-BLOCK EZERTS-REQUEST-BLOCK EXEC CICS HANDLE ABEND CANCEL END-EXEC. EZECICS-RTS-TERMINATE-X. EXIT. *----------------------------------------------------------------- * END OF PROGRAM PGGSS1 *-----------------------------------------------------------------